on time macro

B

buzzharley

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
 
P

Paul Lautman

buzzharley said:
I have a macro on a workbook that when I hit the button it asks for
the
Click to expand...

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

Bob Phillips

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 said:
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
Click to expand...
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
Click to expand...
Date And Shift Has Been Previously Imported") = vbCancel Then
 
B

buzzharley

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 alo
 
B

Bob Phillips

Replace your OnTime statement in MyMacro

--
HTH

Bob Phillips

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

buzzharley

-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

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

ImportData
End Sub
 
B

buzzharley

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!!
 
B

Bob Phillips

Honestly, you would be better off creating a scheduled task in Windows to
launch Excel with a named workbook, and have an Auto_Open macro to do what
you need.

--
HTH

Bob Phillips

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

Paul Lautman

Bob said:
Honestly, you would be better off creating a scheduled task in
Windows to launch Excel with a named workbook, and have an Auto_Open
macro to do what you need.


"buzzharley"
message
Click to expand...

That's what I said!
 
B

Bob Phillips

I know, and I am supporting that statement.

--
HTH

Bob Phillips

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

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

array data type issues - 11
Permutations andText to column problem 6
Very slow Excel Macro 19
Run Time Error "13" on For Each loop 0
vlookup in VBA 3
Find the correct sheet then find a value on that sheet 8
problem with UsedRange 3
Import Macro in PERSONAL.XLS will not import to my main document 8

Top