on time macro

**buzzharley** · 07-05-2006, 08:40 AM

I have a macro on a workbook that when I hit the button it asks for the date of a register sales journal that I want to import. Then it asks for the cash in drawer amount. Then it puts in all of the data into the sales spreadsheet. Now I want to use the on time method to bypass the button and the entry of the date, and even get rid of the cash in drawer. I want to make the macro run at 9:30 every night. I want it to use the date on the computer to tell it which date to find? Here is the code I'm using!
button macro

 
 ' Button2_Click Macro
 Sub Button2_Click() 
    ImportData 
End Sub

And here is the main macro

Function FileExists(sFile As String) As Boolean 
    Dim iLen As Integer 
    On Error Goto NO_FILE 
    FileExists = True 
    iLen = FileLen(sFile) 
    Exit Function 
     NO_FILE: 
    FileExists = False 
    Exit Function 
End Function 
Function SpcEql(sTarget As String) As String 
    Dim iLen As Integer 
    Dim k As Integer 
    Dim sNewTarget As String 
    SpcEql = sTarget 
    sNewTarget = "" 
    iLen = Len(sTarget) 
    For k = 1 To iLen 
        If Mid$(sTarget, k, 1) = "=" Then 
            sNewTarget = sNewTarget & " " 
        Else 
            sNewTarget = sNewTarget & Mid$(sTarget, k, 1) 
        End If 
    Next k 
    SpcEql = sNewTarget 
End Function
Function FormatCol(value As Integer) As String 
    FormatCol = "" 
    Dim newvalue As Integer 
    If value < 27 Then 
        FormatCol = Chr(value + 64) 
    ElseIf value > 26 And value < 53 Then 
        newvalue = value - 26 
        FormatCol = "A" & Chr(newvalue + 64) 
    ElseIf value > 52 And value < 79 Then 
        newvalue = value - 52 
        FormatCol = "B" & Chr(newvalue + 64) 
    ElseIf value > 78 Then 
        newvalue = value - 78 
        FormatCol = "C" & Chr(newvalue + 64) 
    End If 
     End Function 
 Sub ImportData() 
     'On Error GoTo CommonError
    Dim iDataFile As Integer 
     Dim sSheet_IS As String 
    Dim sSheet_ID As String 
    Dim sSheet_IM As String 
    Dim iMaxSub As Integer 
    Dim iMaxDept As Integer 
    Dim sDept As String 
    Dim sSubd As String 
    Dim iDept As Integer 
    Dim iSubd As Integer 
    Dim sGrossSales As String 
    Dim sNetSales As String 
    Dim sQty As String 
    Dim sDesc As String 
     
    Dim sRecord As String 
    Dim sFileDate As String 
    Dim Tax1 As Currency 
    Dim Tax2 As Currency 
    Dim Tax3 As Currency 
    Dim sQtyCol As String 
    Dim sNetCol As String
Dim sGrossCol As String 
    Dim sMiscCol As String 
     Dim iQtyCol As Integer 
    Dim iNetCol As Integer 
    Dim iGrossCol As Integer 
    Dim iMiscCol As Integer 
     Dim sStore As String 
    Dim sPath As String 
     Dim sInputFile As String 
    Dim iQStart1(1 To 100) As Integer 
    Dim iQLength1(1 To 100) As Integer 
    Dim sQValue1(1 To 100) As String 
     Dim iQStart2(1 To 100) As Integer 
    Dim iQLength2(1 To 100) As Integer 
    Dim sQValue2(1 To 100) As String 
     Dim iQStart3(1 To 100) As Integer 
    Dim iQLength3(1 To 100) As Integer 
    Dim sQValue3(1 To 100) As String 
     Dim iVStart(1 To 100) As Integer 
    Dim iVLength(1 To 100) As Integer 
    Dim sVDesc(1 To 100) As String 
     Dim iCountMisc As Integer 
    Dim iCheckDay As Integer 
     Dim Q1 As Boolean 
    Dim Q2 As Boolean 
    Dim Q3 As Boolean 
     Dim cWork As Currency 
     Dim cashdrawer As String 
     'Initialize Variables
    sSheet_IS = "IS" 'Name Of Sheet For Subdepartment
    sSheet_ID = "ID" 'Name of Sheet For Department
    sSheet_IM = "IM" 'Name of Sheet For Miscellaneous
     
    iMaxSub = 9999 'Number of Possible Subdepartments
    iMaxDept = 999 'Number of Possible Departments
     
    Tax1 = 0 
    Tax2 = 0 
    Tax3 = 0 
      '----------------------------------------------
     '   ADJUST DATA FILE PATH HERE
 '
     '   EXAMPLE
     '       sPath = "C:\Datasym\C2WinV2\Data"
     '       AM FILES = sPath Followed By "01-0001Z.DAT"
     '       PM FILES = sPath Followed By "01-0001Z.DAT"
     '----------------------------------------------
    sPath = ThisWorkbook.Path & "\" '  "C:\DATASYM\C2WINV2\DATA\"
     
    Dim sTargetDate As String 
    Dim sDateMMDD As String 
    Dim dDate As Date 
    Dim shift As Integer 
     
    sTargetDate = InputBox("What Date Are You Importing For? (Format MM/DD/YYYY, Example 01/13/2001)") 
    If IsDate(sTargetDate) = False Then 
        MsgBox ("Invalid Date") 
        Exit Sub 
    End If 
    cashdrawer = InputBox("Amount of cash in drawer?") 
     
    Dim sCompareDay As String 
    Dim monthshift As Integer 
     
    sDateMMDD = Format$(sTargetDate, "MMDD") 
    sTargetDate = Format$(sTargetDate, "MM/DD/YYYY") 
    shift = CInt(Mid(sDateMMDD, 3, 2)) - 1 
    sCompareDay = Mid(sTargetDate, 1, 2) & "/01/" & Mid(sTargetDate, 7, 4) 
    monthshift = Weekday(Format$(sCompareDay, "MM/DD/YYYY")) 
     
    iNetCol = 3 + shift + monthshift 
    iQtyCol = 34 + shift + monthshift 
    iGrossCol = 65 + shift + monthshift 
    iMiscCol = 65 + shift + monthshift 
     
    Month_Shift monthshift 
     
    sNetCol = FormatCol(iNetCol) 
    sQtyCol = FormatCol(iQtyCol) 
    sGrossCol = FormatCol(iGrossCol) 
    sMiscCol = FormatCol(iMiscCol) 
     
     
     
    sInputFile = sPath & "01_0001Z.DAT" 
     
     
     '   Empty Data Sheets If There Is Evidence of Previous Import
    If Worksheets(sSheet_IS).Cells(1, iQtyCol).value <> "" Then 
        If MsgBox("Do You Wish To Continue Import?", vbOKCancel, "Data For This Date And Shift Has Been Previously Imported") = vbCancel Then 
            Worksheets("SALES").Activate 
            Exit Sub 
        End If 
         
        Worksheets(sSheet_IS).Activate 
        Columns(sQtyCol & ":" & sQtyCol).ClearContents 
        Columns(sNetCol & ":" & sNetCol).ClearContents 
        Columns(sGrossCol & ":" & sGrossCol).ClearContents 
         
        Worksheets(sSheet_ID).Activate 
        Columns(sQtyCol & ":" & sQtyCol).ClearContents 
        Columns(sNetCol & ":" & sNetCol).ClearContents 
        Columns(sGrossCol & ":" & sGrossCol).ClearContents 
         
        Worksheets(sSheet_IM).Activate 
        Columns(sMiscCol & ":" & sMiscCol).ClearContents 
    End If 
     
    Worksheets("SALES").Activate 
     
     
     
    Dim bDateFound As Boolean 
    bDateFound = False 
     
     'Get Data From COMM2000 Sales File
    iDataFile = FreeFile() 
    Dim bInTarget As Boolean 
    bInTarget = False 
    Open sInputFile For Input As #iDataFile 
    Do While Not EOF(iDataFile) 
        Line Input #iDataFile, sRecord 
         
         'LOOK FOR DATE INFORMATION FROM 00 RECORD
         
        Dim iHour As Integer 
        Dim dTommorow As Date 
        Dim sTommorow As String 
         
        If Mid$(sRecord, 1, 3) = "00," And Len(Trim(sRecord)) > 30 Then 
            dTommorow = DateAdd("d", 1, sTargetDate) 
            sTommorow = Format(dTommorow, "mm/dd/yyyy") 
            iHour = CInt(Mid$(sRecord, 37, 2)) 
            sFileDate = Mid$(sRecord, 26, 2) & "/" 
            sFileDate = sFileDate & Mid$(sRecord, 29, 2) & "/" 
            sFileDate = sFileDate & Mid$(sRecord, 32, 4) 
             
             
             
             '   EXAMPLE HEADER LINES (NORMAL AND SCREWED UP)
             '00,01,H2000     ,01,0002,08,23,2002,02,01,57
             '00,01,H2000     ,01,0002,08,26,2002,18,
             
            If StrComp(sFileDate, sTargetDate) = 0 Then 
                 ' Early Morning Poll (Must Be Yesterday's PM)
                bDateFound = True 
                bInTarget = True 
                Fill_CashDrawer cashdrawer, shift + 1 
            Else 
                bInTarget = False 
                Goto ContinueInLoop 
            End If 
        Else 
            If bInTarget = False Then 
                Goto ContinueInLoop 
            End If 
        End If 
         
       ********* THERE WAS MORE IN HERE BUT IT WAS 2 LONG TO POST IN THIS THREAD!!!**********
 
Public Sub Fill_CashDrawer(amount As String, strday As String) 
    Dim ws As Worksheet 
     
    Set ws = ThisWorkbook.Worksheets("SALES") 
     
    For i = 1 To 100 
        If ws.Cells(i, 2).value = strday Then 
            ws.Cells(i, 18).value = amount 
            Exit For 
        End If 
    Next i 
     
     
End Sub 
 
Public Sub Month_Shift(shift As Integer) 
    Dim ws As Worksheet 
    Dim count As Integer 
     
    Set ws = ThisWorkbook.Worksheets("SALES") 
    For i = 4 To 10 
        ws.Cells(i, 2).value = "" 
    Next i 
    count = 1 
    For i = (4 + shift) To 10 
        ws.Cells(i, 2).value = count 
        count = count + 1 
    Next i 
     
     
End Sub

I've tried this but it doesn't work--

  Sub MyMacro() 
     
    Application.OnTime TimeValue("21:30:00"), "Button2_click" 
     '' Button2_Click Macro
     
    Sub Button2_Click() 
        ImportData 
         
    End Sub

I've looked at the other time method but I'm not sure on what my time interval has to be? It's in seconds right? Also does the on time macro replace the button macro or can I keep both of them? Thanks so much in advance for any help!!- Mike

Paul Lautman · 07-05-2006, 09:25 AM

buzzharley wrote:
> I have a macro on a workbook that when I hit the button it asks for
> the

Why not make the main macro a Workbook_Open one and have the book opened as
a scheduled task?

Bob Phillips · 07-05-2006, 09:50 AM

Just use

Application.OnTime Date + 1 + TimeValue("21:30:00"), "Button2_click"

but this will require the machine to be on 24x7, and Excel to be running.

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"buzzharley" <[email protected]> wrote
in message news:[email protected]...
>
> I have a macro on a workbook that when I hit the button it asks for the
> date of a register sales journal that I want to import. Then it asks
> for the cash in drawer amount. Then it puts in all of the data into the
> sales spreadsheet. Now I want to use the on time method to bypass the
> button and the entry of the date, and even get rid of the cash in
> drawer. I want to make the macro run at 9:30 every night. I want it to
> use the date on the computer to tell it which date to find? Here is the
> code I'm using!
> button macro
> Code:
> --------------------
>
> ' Button2_Click Macro
> Sub Button2_Click()
> ImportData
> End Sub
> --------------------
>
> And here is the main macro
> Code:
> --------------------
> Function FileExists(sFile As String) As Boolean
> Dim iLen As Integer
> On Error Goto NO_FILE
> FileExists = True
> iLen = FileLen(sFile)
> Exit Function
> NO_FILE:
> FileExists = False
> Exit Function
> End Function
> Function SpcEql(sTarget As String) As String
> Dim iLen As Integer
> Dim k As Integer
> Dim sNewTarget As String
> SpcEql = sTarget
> sNewTarget = ""
> iLen = Len(sTarget)
> For k = 1 To iLen
> If Mid$(sTarget, k, 1) = "=" Then
> sNewTarget = sNewTarget & " "
> Else
> sNewTarget = sNewTarget & Mid$(sTarget, k, 1)
> End If
> Next k
> SpcEql = sNewTarget
> End Function
> Function FormatCol(value As Integer) As String
> FormatCol = ""
> Dim newvalue As Integer
> If value < 27 Then
> FormatCol = Chr(value + 64)
> ElseIf value > 26 And value < 53 Then
> newvalue = value - 26
> FormatCol = "A" & Chr(newvalue + 64)
> ElseIf value > 52 And value < 79 Then
> newvalue = value - 52
> FormatCol = "B" & Chr(newvalue + 64)
> ElseIf value > 78 Then
> newvalue = value - 78
> FormatCol = "C" & Chr(newvalue + 64)
> End If
> End Function
> Sub ImportData()
> 'On Error GoTo CommonError
> Dim iDataFile As Integer
> Dim sSheet_IS As String
> Dim sSheet_ID As String
> Dim sSheet_IM As String
> Dim iMaxSub As Integer
> Dim iMaxDept As Integer
> Dim sDept As String
> Dim sSubd As String
> Dim iDept As Integer
> Dim iSubd As Integer
> Dim sGrossSales As String
> Dim sNetSales As String
> Dim sQty As String
> Dim sDesc As String
>
> Dim sRecord As String
> Dim sFileDate As String
> Dim Tax1 As Currency
> Dim Tax2 As Currency
> Dim Tax3 As Currency
> Dim sQtyCol As String
> Dim sNetCol As String
> Dim sGrossCol As String
> Dim sMiscCol As String
> Dim iQtyCol As Integer
> Dim iNetCol As Integer
> Dim iGrossCol As Integer
> Dim iMiscCol As Integer
> Dim sStore As String
> Dim sPath As String
> Dim sInputFile As String
> Dim iQStart1(1 To 100) As Integer
> Dim iQLength1(1 To 100) As Integer
> Dim sQValue1(1 To 100) As String
> Dim iQStart2(1 To 100) As Integer
> Dim iQLength2(1 To 100) As Integer
> Dim sQValue2(1 To 100) As String
> Dim iQStart3(1 To 100) As Integer
> Dim iQLength3(1 To 100) As Integer
> Dim sQValue3(1 To 100) As String
> Dim iVStart(1 To 100) As Integer
> Dim iVLength(1 To 100) As Integer
> Dim sVDesc(1 To 100) As String
> Dim iCountMisc As Integer
> Dim iCheckDay As Integer
> Dim Q1 As Boolean
> Dim Q2 As Boolean
> Dim Q3 As Boolean
> Dim cWork As Currency
> Dim cashdrawer As String
> 'Initialize Variables
> sSheet_IS = "IS" 'Name Of Sheet For Subdepartment
> sSheet_ID = "ID" 'Name of Sheet For Department
> sSheet_IM = "IM" 'Name of Sheet For Miscellaneous
>
> iMaxSub = 9999 'Number of Possible Subdepartments
> iMaxDept = 999 'Number of Possible Departments
>
> Tax1 = 0
> Tax2 = 0
> Tax3 = 0
> '----------------------------------------------
> ' ADJUST DATA FILE PATH HERE
> '
> ' EXAMPLE
> ' sPath = "C:\Datasym\C2WinV2\Data"
> ' AM FILES = sPath Followed By "01-0001Z.DAT"
> ' PM FILES = sPath Followed By "01-0001Z.DAT"
> '----------------------------------------------
> sPath = ThisWorkbook.Path & "\" ' "C:\DATASYM\C2WINV2\DATA\"
>
> Dim sTargetDate As String
> Dim sDateMMDD As String
> Dim dDate As Date
> Dim shift As Integer
>
> sTargetDate = InputBox("What Date Are You Importing For? (Format
MM/DD/YYYY, Example 01/13/2001)")
> If IsDate(sTargetDate) = False Then
> MsgBox ("Invalid Date")
> Exit Sub
> End If
> cashdrawer = InputBox("Amount of cash in drawer?")
>
> Dim sCompareDay As String
> Dim monthshift As Integer
>
> sDateMMDD = Format$(sTargetDate, "MMDD")
> sTargetDate = Format$(sTargetDate, "MM/DD/YYYY")
> shift = CInt(Mid(sDateMMDD, 3, 2)) - 1
> sCompareDay = Mid(sTargetDate, 1, 2) & "/01/" & Mid(sTargetDate, 7, 4)
> monthshift = Weekday(Format$(sCompareDay, "MM/DD/YYYY"))
>
> iNetCol = 3 + shift + monthshift
> iQtyCol = 34 + shift + monthshift
> iGrossCol = 65 + shift + monthshift
> iMiscCol = 65 + shift + monthshift
>
> Month_Shift monthshift
>
> sNetCol = FormatCol(iNetCol)
> sQtyCol = FormatCol(iQtyCol)
> sGrossCol = FormatCol(iGrossCol)
> sMiscCol = FormatCol(iMiscCol)
>
>
>
> sInputFile = sPath & "01_0001Z.DAT"
>
>
> ' Empty Data Sheets If There Is Evidence of Previous Import
> If Worksheets(sSheet_IS).Cells(1, iQtyCol).value <> "" Then
> If MsgBox("Do You Wish To Continue Import?", vbOKCancel, "Data For This
Date And Shift Has Been Previously Imported") = vbCancel Then
> Worksheets("SALES").Activate
> Exit Sub
> End If
>
> Worksheets(sSheet_IS).Activate
> Columns(sQtyCol & ":" & sQtyCol).ClearContents
> Columns(sNetCol & ":" & sNetCol).ClearContents
> Columns(sGrossCol & ":" & sGrossCol).ClearContents
>
> Worksheets(sSheet_ID).Activate
> Columns(sQtyCol & ":" & sQtyCol).ClearContents
> Columns(sNetCol & ":" & sNetCol).ClearContents
> Columns(sGrossCol & ":" & sGrossCol).ClearContents
>
> Worksheets(sSheet_IM).Activate
> Columns(sMiscCol & ":" & sMiscCol).ClearContents
> End If
>
> Worksheets("SALES").Activate
>
>
>
> Dim bDateFound As Boolean
> bDateFound = False
>
> 'Get Data From COMM2000 Sales File
> iDataFile = FreeFile()
> Dim bInTarget As Boolean
> bInTarget = False
> Open sInputFile For Input As #iDataFile
> Do While Not EOF(iDataFile)
> Line Input #iDataFile, sRecord
>
> 'LOOK FOR DATE INFORMATION FROM 00 RECORD
>
> Dim iHour As Integer
> Dim dTommorow As Date
> Dim sTommorow As String
>
> If Mid$(sRecord, 1, 3) = "00," And Len(Trim(sRecord)) > 30 Then
> dTommorow = DateAdd("d", 1, sTargetDate)
> sTommorow = Format(dTommorow, "mm/dd/yyyy")
> iHour = CInt(Mid$(sRecord, 37, 2))
> sFileDate = Mid$(sRecord, 26, 2) & "/"
> sFileDate = sFileDate & Mid$(sRecord, 29, 2) & "/"
> sFileDate = sFileDate & Mid$(sRecord, 32, 4)
>
>
>
> ' EXAMPLE HEADER LINES (NORMAL AND SCREWED UP)
> '00,01,H2000 ,01,0002,08,23,2002,02,01,57
> '00,01,H2000 ,01,0002,08,26,2002,18,
>
> If StrComp(sFileDate, sTargetDate) = 0 Then
> ' Early Morning Poll (Must Be Yesterday's PM)
> bDateFound = True
> bInTarget = True
> Fill_CashDrawer cashdrawer, shift + 1
> Else
> bInTarget = False
> Goto ContinueInLoop
> End If
> Else
> If bInTarget = False Then
> Goto ContinueInLoop
> End If
> End If
>
> ********* THERE WAS MORE IN HERE BUT IT WAS 2 LONG TO POST IN THIS
THREAD!!!**********
>
> Public Sub Fill_CashDrawer(amount As String, strday As String)
> Dim ws As Worksheet
>
> Set ws = ThisWorkbook.Worksheets("SALES")
>
> For i = 1 To 100
> If ws.Cells(i, 2).value = strday Then
> ws.Cells(i, 18).value = amount
> Exit For
> End If
> Next i
>
>
> End Sub
>
> Public Sub Month_Shift(shift As Integer)
> Dim ws As Worksheet
> Dim count As Integer
>
> Set ws = ThisWorkbook.Worksheets("SALES")
> For i = 4 To 10
> ws.Cells(i, 2).value = ""
> Next i
> count = 1
> For i = (4 + shift) To 10
> ws.Cells(i, 2).value = count
> count = count + 1
> Next i
>
>
> End Sub
>
> --------------------
>
> I've tried this but it doesn't work--
> Code:
> --------------------
> Sub MyMacro()
>
> Application.OnTime TimeValue("21:30:00"), "Button2_click"
> '' Button2_Click Macro
>
> Sub Button2_Click()
> ImportData
>
> End Sub
> --------------------
>
> I've looked at the other time method but I'm not sure on what my time
> interval has to be? It's in seconds right? Also does the on time
> macro replace the button macro or can I keep both of them? Thanks so
> much in advance for any help!!- Mike
>
>
> --
> buzzharley
> ------------------------------------------------------------------------
> buzzharley's Profile:
http://www.excelforum.com/member.php...o&userid=35886
> View this thread: http://www.excelforum.com/showthread...hreadid=558403
>

**buzzharley** · 07-05-2006, 02:51 PM

Thanks for the help!! Where should I put-

Application.OnTime Date + 1 + TimeValue("21:30:00"), "Button2_click"
Make it a new macro or add it to the macro button? Thanks alot

Bob Phillips · 07-05-2006, 07:40 PM

Replace your OnTime statement in MyMacro

--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"buzzharley" <[email protected]> wrote
in message news:[email protected]...
>
> Thanks for the help!! Where should I put-
>
> Application.OnTime Date + 1 + TimeValue("21:30:00"), "Button2_click"
> Make it a new macro or add it to the macro button? Thanks alot
>
>
> --
> buzzharley
> ------------------------------------------------------------------------
> buzzharley's Profile:
http://www.excelforum.com/member.php...o&userid=35886
> View this thread: http://www.excelforum.com/showthread...hreadid=558403
>

**buzzharley** · 07-05-2006, 09:31 PM

-Bob- Thanks so much but what do you mean by "Replace your OnTime statement in MyMacro" replace the other macro I posted before?

I've tried this

Sub Mymacro()
Application.OnTime Date + 1 + TimeValue("20:14:00"), "Button2_click"
' Button2_Click Macro

    ImportData
End Sub

Then if I advance my computer time it will work once, then if I advance another day again thae it does run again? Any Sugestions-- Thanks

**buzzharley** · 07-06-2006, 12:03 AM

I'm so lost!! I've been trying all night long to just get a macro to run once everyday! Do I need to enter something like repeat the ontime in the Macro that I have the ontime running so It keeps running everyday?

Is there a special way to start running the ontime- I've read to save it then reopen the workbook, the run the macro? I have been trying to go into the future by advancing a day in the calander of my computer. It will work once and then it won't work again the next day!!