Problem in automating using a button created by recording a macro

E

ExcelVBAnewbie

I have a macro code (module) which I can run and do number of manuall
processes, I get the right result..

However, I did recod a excel macro and saved it, ran it to get the desired
result, I don't get the right result, mainly if I am pulling the data 1 or
more earlier days data.

Here is what my recoded macro looks like ( I have shown both macros)
however, I modified some of the contents of codes (VB given by excel macro
in my module 2
I thank you for your prompt replyin anticipation. However I have some more
questions to perform this tasks, as you noticed that I am sort of newbie in
VBA.

I hope you will take some time to help since it is due today for me:

I started recordng macro, and gave the macro name "FiascoDailyReport"

Basically,
Assuming I am creating the report for 1/17/08 (Thursday)
If I am creating the report of sameday 1/17/9/08, then I will go to
TOOLS>>Macros>>SELECT POPULATE>>RUN THE REPORT

"note : Two columns are hidden as a placeholder for MONTH to date and Year
to Date
In the example"

Thurday
Go to TotalHours Section of the Report (an Excel Sheet) i., E63 for Thursay
(this value referes to the value from the states, ca, AL, FL and so on ,
select only CA for this time
"one can select all the states, but if I select all the states it doesn’t
work kinda gives duplicate values and could not be performed the operation ,
I mean a dialogue box appears saying so"

Copy the value E63 and paste to <Total> tab ( so need to select TOTAL tab
first), this cell is till points to E63
(the above process of copying is done to avoid the circular references.)
Write FORMULA in the formula bar, (Leads consumed/Leads consumed by
States)*total hrs (E67/States!Exx)*total hrs(the selected cell’s value itself)
( States refers to "TOTAL" the value refers to the total tab’s value>
Hit Enter
Copy hours and paste special (look the values , i.e CHECK THE VALUES OF
HOURS IN THE FORMULA BAR AFTER COPYING AND PASTING SPECIAL WITH VALUE
PARAMETERS ARE DONE).

l with value selected in the same cell.HIT Enter

Copy the formula from the cell of the WED (Prev Day) where the formula
already exist and paste it to the ThursDay (Current Day) while we have
selected <states> tab, i.e states means total

this is done since the current day in the total tab doesn’t have the formula
bar.
To reiterate, One needs all the States tab like CA, AL, IL …have value in
the formula bar whereas in the total tab it should be filled with the formula
bar.
This process is done after the formula process is over.

Now I stopped my macro named "FiascoDailyReport" and assigned this macro to
a button which works fine.

However, when run this macro with 2 days or 1 day earlier, then I don't get
the right data.

I tried to put some constraint in the code, but did not work either

SO can you help me, please


2nd module:

Sub FiascoDailyReport()
'
' FiascoDailyReport Macro
' Macro recorded 1/17/2008 by Nathan Was Aprogrammer'

'
Application.Run "'FiOS DP 01-17-State Report.xls'!populate"
Dim statesall As String
Sheets("CA").Select
Range("E63").Select
If Range("E63") > 0 Then
Selection.Copy
Sheets("States").Select
ActiveSheet.Paste
ElseIf Sheets("FL").Select And Range("E63") > 0 Then
Selection.Copy
Sheets("States").Select
ActiveSheet.Paste
Else: statesall = "call IT"
End If

Sheets(Array("CA", "CT", "DE", "FL", "IN", "MA", "MD", "NH", "NJ", "NY",
"OR", "PA", "RI", _
"TX", "VA", "WA")).Select
ActiveCell.FormulaR1C1 = "=(R[4]C/States!R[4]C)*States!RC"
Range("E63").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Sheets("States").Select
Range("F63").Select
Application.CutCopyMode = False
Selection.Copy
Range("E63").Select
ActiveSheet.Paste
Sheets("States").Select
Sheets("CA").Select
X = Range("E63").Select
Sheets("FL").Select
Y = Range("E63").Select
Sheets("States").Select
Z = Range("F63").Select
Dim check As String
If Z > X + Y Then
check = "pass"
Else: check = "problem"
End If
ActiveWorkbook.Save
End Sub

First Module:


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

***********************************

Sub AddUDFToCategory()
'------------------------------------------------------------------------------
' insert after Description line [optional]: Category:=2, _ => Date & Time
'------------------------------------------------------------------------------
' If the UDF's are in an Addin (.xla) it's better to qualify the function name
' like this:
' Macro:=ThisWorkbook.Name & "!" & "DayName"
'------------------------------------------------------------------------------
' see also Excel help for Application.MacroOptions
'------------------------------------------------------------------------------
application.MacroOptions _
Macro:="TestMacro", _
Description:="This function gives back the 'Hello world' message!", _
Category:=2, _
HelpFile:=ThisWorkbook.Path & "\CHM-example.chm", _
HelpContextID:=10000
application.MacroOptions _
Macro:="DayName", _
Description:="A Function That Gives the Name of the Day", _
Category:=2, _
HelpFile:=ThisWorkbook.Path & "\CHM-example.chm", _
HelpContextID:=20000
End Sub
Function TestMacro()
'----------------------------------------------------------------
' Display a message box with a help button linked to a help topic
'----------------------------------------------------------------
MsgBox "The 'Hello World' message for testing this function!.", _
Buttons:=vbOKOnly + vbMsgBoxHelpButton, _
HelpFile:=ThisWorkbook.Path & "\CHM-example.chm", _
Context:=20010
End Function

Function DayName(InputDate As Date)
'---------------------------------------------
'--- A Function That Gives the Name of the Day
'--- http://www.fontstuff.com/vba/vbatut01.htm
'---------------------------------------------
Dim DayNumber As Integer
DayNumber = Weekday(InputDate, vbSunday)
Select Case DayNumber
Case 1
DayName = "Sunday"
Case 2
DayName = "Monday"
Case 3
DayName = "Tuesday"
Case 4
DayName = "Wednesday"
Case 5
DayName = "Thursday"
Case 6
DayName = "Friday"
Case 7
DayName = "Saturday"
End Select
End Function
 

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

Top