Automation of report, daily, monthly then yearly as per need

M

MyCraigsList2006

I need to make this macro to work for any day's data, even weekly
total or mothly if possible.

But in this case it captures the value from the date 1/16/2008

Please advise me how can I automate this process getting all the
report for any date. which means the diffrent date captures the date
from diffrent cells.



Sub FIOSDailyReport()
'
' FIOSDailyReport Macro
' Macro recorded 1/16/2008 by the legend of Joomla
'

'
Application.Run "'Verizon FiOS DP 01-16-State Report.xls'!
populate"
Sheets("CA").Select
Range("D63").Select
Selection.Copy
Sheets("States").Select
Range("D63").Select
ActiveSheet.Paste
Application.WindowState = xlMinimized
Application.WindowState = xlNormal
Sheets(Array("CA", "CT", "DE", "FL", "IN", "MA", "MD", "NH", "NJ",
"NY", "OR", "PA", "RI", _
"TX", "VA", "WA")).Select
Sheets("CA").Activate
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=(R[4]C/States!R[4]C)*States!RC"
Range("D63").Select
Selection.Copy
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets(Array("States", "CA", "CT", "DE", "FL", "IN", "MA", "MD",
"NH", "NJ", "NY", "OR", _
"PA", "RI", "TX", "VA", "WA")).Select
Sheets("States").Activate
Range("D63").Select
Sheets("States").Select
Range("C63").Select
Application.CutCopyMode = False
Selection.Copy
Range("D63").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub

******************************************
the macro which is saved in module 1
Dim reportDate As Integer

Public Sub populate()

Dim rptCol As String

rptCol = getCol()


populateTab "Non-Fios DP", "Non-Fios DP", rptCol

End Sub
Private Sub populateTab(rptTab As String, dbView As String, rptCol As
String)

On Error GoTo err

Dim DBConnection As ADODB.Connection
Dim RS As ADODB.Recordset
Dim strSQL As String
Dim state As String

Set DBConnection = New ADODB.Connection
Set RS = New ADODB.Recordset
DBConnection.CommandTimeout = 1200
DBConnection.Open "Provider=SQLOLEDB.7;Password=master;Persist
Security Info=True;User ID=master;Initial Catalog=FiOS;Data
Source=VPSSQL01;"

strSQL = "select * from [fn_get_TM_State_Report_NEW]('" & (Date -
reportDate) & "') where state is not null"
RS.Open strSQL, DBConnection

RS.MoveFirst

Do Until RS.EOF

state = RS![state]

Worksheets(state).Range(rptCol & "9").Cells.Value = RS![Row9]
Worksheets(state).Range(rptCol & "10").Cells.Value = RS!
[Row10]
Worksheets(state).Range(rptCol & "11").Cells.Value = RS!
[Row11]
Worksheets(state).Range(rptCol & "15").Cells.Value = RS!
[Row15]
Worksheets(state).Range(rptCol & "16").Cells.Value = RS!
[Row16]
Worksheets(state).Range(rptCol & "23").Cells.Value = RS!
[Row23]
Worksheets(state).Range(rptCol & "24").Cells.Value = RS!
[Row24]
Worksheets(state).Range(rptCol & "25").Cells.Value = RS!
[Row25]
Worksheets(state).Range(rptCol & "26").Cells.Value = RS!
[Row26]
Worksheets(state).Range(rptCol & "27").Cells.Value = RS!
[Row27]
Worksheets(state).Range(rptCol & "28").Cells.Value = RS!
[Row28]
Worksheets(state).Range(rptCol & "29").Cells.Value = RS!
[Row29]
Worksheets(state).Range(rptCol & "32").Cells.Value = RS!
[Row32]
Worksheets(state).Range(rptCol & "33").Cells.Value = RS!
[Row33]
Worksheets(state).Range(rptCol & "34").Cells.Value = RS!
[Row34]
Worksheets(state).Range(rptCol & "35").Cells.Value = RS!
[Row35]
Worksheets(state).Range(rptCol & "36").Cells.Value = RS!
[Row36]
Worksheets(state).Range(rptCol & "37").Cells.Value = RS!
[Row37]
Worksheets(state).Range(rptCol & "38").Cells.Value = RS!
[Row38]
Worksheets(state).Range(rptCol & "39").Cells.Value = RS!
[Row39]
Worksheets(state).Range(rptCol & "40").Cells.Value = RS!
[Row40]
Worksheets(state).Range(rptCol & "41").Cells.Value = RS!
[Row41]
Worksheets(state).Range(rptCol & "42").Cells.Value = RS!
[Row42]
Worksheets(state).Range(rptCol & "44").Cells.Value = RS!
[Row44]
'Worksheets(state).Range(rptCol & "32").Cells.Value = RS!
[Row32]
Worksheets(state).Range(rptCol & "45").Cells.Value = RS!
[Row45]
Worksheets(state).Range(rptCol & "47").Cells.Value = RS!
[Row47]
'Worksheets(state).Range(rptCol & 485").Cells.Value = RS!
[Row35]
Worksheets(state).Range(rptCol & "49").Cells.Value = RS!
[Row49]
Worksheets(state).Range(rptCol & "50").Cells.Value = RS!
[Row50]
Worksheets(state).Range(rptCol & "51").Cells.Value = RS!
[Row51]
Worksheets(state).Range(rptCol & "53").Cells.Value = RS!
[Row53]
Worksheets(state).Range(rptCol & "54").Cells.Value = RS!
[Row54]
Worksheets(state).Range(rptCol & "55").Cells.Value = RS!
[Row55]
Worksheets(state).Range(rptCol & "59").Cells.Value = RS!
[Row59]
Worksheets(state).Range(rptCol & "63").Cells.Value = RS!
[Row63]
Worksheets(state).Range(rptCol & "68").Cells.Value = RS!
[Row68]
'Worksheets(state).Range(rptCol & "45").Cells.Value = RS!
[Row45]
'Worksheets(state).Range(rptCol & "46").Cells.Value = RS!
[Row46]
Worksheets(state).Range(rptCol & "77").Cells.Value = RS!
[Row77]
Worksheets(state).Range(rptCol & "78").Cells.Value = RS!
[Row78]
Worksheets(state).Range(rptCol & "79").Cells.Value = RS!
[Row79]
Worksheets(state).Range(rptCol & "81").Cells.Value = RS!
[Row81]
Worksheets(state).Range(rptCol & "82").Cells.Value = RS!
[Row82]
Worksheets(state).Range(rptCol & "83").Cells.Value = RS!
[Row83]
Worksheets(state).Range(rptCol & "84").Cells.Value = RS!
[Row84]
Worksheets(state).Range(rptCol & "85").Cells.Value = RS!
[Row85]
Worksheets(state).Range(rptCol & "86").Cells.Value = RS!
[Row86]
Worksheets(state).Range(rptCol & "88").Cells.Value = RS!
[Row88]
Worksheets(state).Range(rptCol & "89").Cells.Value = RS!
[Row89]
Worksheets(state).Range(rptCol & "91").Cells.Value = RS!
[Row91]
Worksheets(state).Range(rptCol & "96").Cells.Value = RS!
[Row96]
Worksheets(state).Range(rptCol & "98").Cells.Value = RS!
[Row98]
Worksheets(state).Range(rptCol & "99").Cells.Value = RS!
[Row99]
Worksheets(state).Range(rptCol & "102").Cells.Value = RS!
[Row102]
Worksheets(state).Range(rptCol & "105").Cells.Value = RS!
[Row105]
Worksheets(state).Range(rptCol & "106").Cells.Value = RS!
[Row106]
Worksheets(state).Range(rptCol & "107").Cells.Value = RS!
[Row107]
Worksheets(state).Range(rptCol & "108").Cells.Value = RS!
[Row108]
Worksheets(state).Range(rptCol & "112").Cells.Value = RS!
[Row112]
Worksheets(state).Range(rptCol & "113").Cells.Value = RS!
[Row113]
Worksheets(state).Range(rptCol & "115").Cells.Value = RS!
[Row115]
Worksheets(state).Range(rptCol & "116").Cells.Value = RS!
[Row116]
Worksheets(state).Range(rptCol & "120").Cells.Value = RS!
[Row120]
Worksheets(state).Range(rptCol & "121").Cells.Value = RS!
[Row121]
Worksheets(state).Range(rptCol & "122").Cells.Value = RS!
[Row122]
Worksheets(state).Range(rptCol & "123").Cells.Value = RS!
[Row123]
Worksheets(state).Range(rptCol & "128").Cells.Value = RS!
[Row128]

RS.MoveNext

Loop

RS.Close
Set RS = Nothing


Exit Sub


err:

If err.Number = 3021 Then

Resume Next

Else

MsgBox err.Number & " " & err.Description
'MsgBox state
Resume Next
End If

End Sub




Private Function getDate() As Integer

reportDate = InputBox("How many days back?", "Set Report Date")

getDate = Weekday(Date - reportDate, vbMonday)

End Function


Private Function getCol() As String

Select Case getDate()

Case 1:
' newWeek
getCol = "B"

Case 2:
getCol = "C"

Case 3:
getCol = "D"

Case 4:
getCol = "E"

Case 5:
getCol = "F"

Case 6:
getCol = "G"

Case 7:
getCol = "H"

End Select

End Function


Any advice thanks
(e-mail address removed)
 
J

Joel

The code you have is only looking at columns B to H for the days of the week
Monday to Sunday respectively. The getcol macro simply is taking todays date
and subtracting the needed date to get the correct column.

reportDate = InputBox("How many days back?", "Set Report Date")

getDate = Weekday(Date - reportDate, vbMonday)

where getdate returns a number from 1 to 7 (the day of the week)

The getcol the turns the 1 -= 7 number into a column

Select Case getDate()

Case 1:
' newWeek
getCol = "B"

Case 2:
getCol = "C"

Case 3:
getCol = "D"

Case 4:
getCol = "E"

Case 5:
getCol = "F"

Case 6:
getCol = "G"

Case 7:
getCol = "H"


The best way of getting any date is to put the date associated with each
column at the top of the column. Then when you are searching for old dates
you can search for the date.

[email protected] said:
I need to make this macro to work for any day's data, even weekly
total or mothly if possible.

But in this case it captures the value from the date 1/16/2008

Please advise me how can I automate this process getting all the
report for any date. which means the diffrent date captures the date
from diffrent cells.



Sub FIOSDailyReport()
'
' FIOSDailyReport Macro
' Macro recorded 1/16/2008 by the legend of Joomla
'

'
Application.Run "'Verizon FiOS DP 01-16-State Report.xls'!
populate"
Sheets("CA").Select
Range("D63").Select
Selection.Copy
Sheets("States").Select
Range("D63").Select
ActiveSheet.Paste
Application.WindowState = xlMinimized
Application.WindowState = xlNormal
Sheets(Array("CA", "CT", "DE", "FL", "IN", "MA", "MD", "NH", "NJ",
"NY", "OR", "PA", "RI", _
"TX", "VA", "WA")).Select
Sheets("CA").Activate
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=(R[4]C/States!R[4]C)*States!RC"
Range("D63").Select
Selection.Copy
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets(Array("States", "CA", "CT", "DE", "FL", "IN", "MA", "MD",
"NH", "NJ", "NY", "OR", _
"PA", "RI", "TX", "VA", "WA")).Select
Sheets("States").Activate
Range("D63").Select
Sheets("States").Select
Range("C63").Select
Application.CutCopyMode = False
Selection.Copy
Range("D63").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub

******************************************
the macro which is saved in module 1
Dim reportDate As Integer

Public Sub populate()

Dim rptCol As String

rptCol = getCol()


populateTab "Non-Fios DP", "Non-Fios DP", rptCol

End Sub
Private Sub populateTab(rptTab As String, dbView As String, rptCol As
String)

On Error GoTo err

Dim DBConnection As ADODB.Connection
Dim RS As ADODB.Recordset
Dim strSQL As String
Dim state As String

Set DBConnection = New ADODB.Connection
Set RS = New ADODB.Recordset
DBConnection.CommandTimeout = 1200
DBConnection.Open "Provider=SQLOLEDB.7;Password=master;Persist
Security Info=True;User ID=master;Initial Catalog=FiOS;Data
Source=VPSSQL01;"

strSQL = "select * from [fn_get_TM_State_Report_NEW]('" & (Date -
reportDate) & "') where state is not null"
RS.Open strSQL, DBConnection

RS.MoveFirst

Do Until RS.EOF

state = RS![state]

Worksheets(state).Range(rptCol & "9").Cells.Value = RS![Row9]
Worksheets(state).Range(rptCol & "10").Cells.Value = RS!
[Row10]
Worksheets(state).Range(rptCol & "11").Cells.Value = RS!
[Row11]
Worksheets(state).Range(rptCol & "15").Cells.Value = RS!
[Row15]
Worksheets(state).Range(rptCol & "16").Cells.Value = RS!
[Row16]
Worksheets(state).Range(rptCol & "23").Cells.Value = RS!
[Row23]
Worksheets(state).Range(rptCol & "24").Cells.Value = RS!
[Row24]
Worksheets(state).Range(rptCol & "25").Cells.Value = RS!
[Row25]
Worksheets(state).Range(rptCol & "26").Cells.Value = RS!
[Row26]
Worksheets(state).Range(rptCol & "27").Cells.Value = RS!
[Row27]
Worksheets(state).Range(rptCol & "28").Cells.Value = RS!
[Row28]
Worksheets(state).Range(rptCol & "29").Cells.Value = RS!
[Row29]
Worksheets(state).Range(rptCol & "32").Cells.Value = RS!
[Row32]
Worksheets(state).Range(rptCol & "33").Cells.Value = RS!
[Row33]
Worksheets(state).Range(rptCol & "34").Cells.Value = RS!
[Row34]
Worksheets(state).Range(rptCol & "35").Cells.Value = RS!
[Row35]
Worksheets(state).Range(rptCol & "36").Cells.Value = RS!
[Row36]
Worksheets(state).Range(rptCol & "37").Cells.Value = RS!
[Row37]
Worksheets(state).Range(rptCol & "38").Cells.Value = RS!
[Row38]
Worksheets(state).Range(rptCol & "39").Cells.Value = RS!
[Row39]
Worksheets(state).Range(rptCol & "40").Cells.Value = RS!
[Row40]
Worksheets(state).Range(rptCol & "41").Cells.Value = RS!
[Row41]
Worksheets(state).Range(rptCol & "42").Cells.Value = RS!
[Row42]
Worksheets(state).Range(rptCol & "44").Cells.Value = RS!
[Row44]
'Worksheets(state).Range(rptCol & "32").Cells.Value = RS!
[Row32]
Worksheets(state).Range(rptCol & "45").Cells.Value = RS!
[Row45]
Worksheets(state).Range(rptCol & "47").Cells.Value = RS!
[Row47]
'Worksheets(state).Range(rptCol & 485").Cells.Value = RS!
[Row35]
Worksheets(state).Range(rptCol & "49").Cells.Value = RS!
[Row49]
Worksheets(state).Range(rptCol & "50").Cells.Value = RS!
[Row50]
Worksheets(state).Range(rptCol & "51").Cells.Value = RS!
[Row51]
Worksheets(state).Range(rptCol & "53").Cells.Value = RS!
[Row53]
Worksheets(state).Range(rptCol & "54").Cells.Value = RS!
[Row54]
Worksheets(state).Range(rptCol & "55").Cells.Value = RS!
[Row55]
Worksheets(state).Range(rptCol & "59").Cells.Value = RS!
[Row59]
Worksheets(state).Range(rptCol & "63").Cells.Value = RS!
[Row63]
Worksheets(state).Range(rptCol & "68").Cells.Value = RS!
[Row68]
'Worksheets(state).Range(rptCol & "45").Cells.Value = RS!
[Row45]
'Worksheets(state).Range(rptCol & "46").Cells.Value = RS!
[Row46]
Worksheets(state).Range(rptCol & "77").Cells.Value = RS!
[Row77]
Worksheets(state).Range(rptCol & "78").Cells.Value = RS!
[Row78]
Worksheets(state).Range(rptCol & "79").Cells.Value = RS!
[Row79]
Worksheets(state).Range(rptCol & "81").Cells.Value = RS!
[Row81]
Worksheets(state).Range(rptCol & "82").Cells.Value = RS!
[Row82]
Worksheets(state).Range(rptCol & "83").Cells.Value = RS!
[Row83]
Worksheets(state).Range(rptCol & "84").Cells.Value = RS!
[Row84]
Worksheets(state).Range(rptCol & "85").Cells.Value = RS!
[Row85]
Worksheets(state).Range(rptCol & "86").Cells.Value = RS!
[Row86]
Worksheets(state).Range(rptCol & "88").Cells.Value = RS!
[Row88]
Worksheets(state).Range(rptCol & "89").Cells.Value = RS!
[Row89]
Worksheets(state).Range(rptCol & "91").Cells.Value = RS!
[Row91]
Worksheets(state).Range(rptCol & "96").Cells.Value = RS!
[Row96]
Worksheets(state).Range(rptCol & "98").Cells.Value = RS!
[Row98]
Worksheets(state).Range(rptCol & "99").Cells.Value = RS!
[Row99]
Worksheets(state).Range(rptCol & "102").Cells.Value = RS!
[Row102]
Worksheets(state).Range(rptCol & "105").Cells.Value = RS!
[Row105]
Worksheets(state).Range(rptCol & "106").Cells.Value = RS!
[Row106]
Worksheets(state).Range(rptCol & "107").Cells.Value = RS!
[Row107]
Worksheets(state).Range(rptCol & "108").Cells.Value = RS!
[Row108]
Worksheets(state).Range(rptCol & "112").Cells.Value = RS!
[Row112]
Worksheets(state).Range(rptCol & "113").Cells.Value = RS!
[Row113]
Worksheets(state).Range(rptCol & "115").Cells.Value = RS!
[Row115]
Worksheets(state).Range(rptCol & "116").Cells.Value = RS!
[Row116]
Worksheets(state).Range(rptCol & "120").Cells.Value = RS!
[Row120]
Worksheets(state).Range(rptCol & "121").Cells.Value = RS!
[Row121]
Worksheets(state).Range(rptCol & "122").Cells.Value = RS!
[Row122]
Worksheets(state).Range(rptCol & "123").Cells.Value = RS!
[Row123]
Worksheets(state).Range(rptCol & "128").Cells.Value = RS!
[Row128]

RS.MoveNext

Loop

RS.Close
Set RS = Nothing


Exit Sub


err:

If err.Number = 3021 Then

Resume Next

Else

MsgBox err.Number & " " & err.Description
'MsgBox state
Resume Next
End If

End Sub




Private Function getDate() As Integer

reportDate = InputBox("How many days back?", "Set Report Date")

getDate = Weekday(Date - reportDate, vbMonday)

End Function


Private Function getCol() As String

Select Case getDate()

Case 1:
' newWeek
getCol = "B"

Case 2:
getCol = "C"

Case 3:
getCol = "D"

Case 4:
getCol = "E"

Case 5:
getCol = "F"

Case 6:
getCol = "G"

Case 7:
getCol = "H"

End Select
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Problem in automating using a button created by recording a macro 0
Need assistance with secondary axis in Excel 2007 0
Automation of report, daily, monthly then yearly as per need 0
-1 returned as last record of recordset object 1

Top