Daily auto macro activation

[cmmadn]

Dear All

I am hoping someone will be able to help me, I have a procedure that I run every workday Mon - Fri. Now I have heard that it is possible to add a section of code and have the procedure run itself at a given time each day. What I would like to know is this true and if so can anyone advise me how I go about achieving this.

whether this will be any use to you in terms of assisting me I have included a copy of the code I have written.

Option Explicit
Sub DealingConsolidation()

Dim objWSKADeals As Worksheet, objADNdeals As Worksheet
Dim objAPWdeals As Worksheet, objRDBdeals As Worksheet

Dim rngADNdeals As Range, rngADNdeal As Range, rngAPWdeals As Range
Dim rngAPWdeal As Range, rngRDBdeals As Range, rngRDBdeal As Range
Dim rngAllSheet As Range, rngFoundDeal As Range, rngLastAddress As Range

Dim strTmonth As String, strLmonth As String, strOpenAllDeals As String
Dim strDealsDte As String, strFirstAddress As String, strDealsShtRte As String
Dim strAllDealsRte As String, strPMAllDeals As String, strTAllDeals As String
Dim strConsolA As String, strConsolB As String, strConsolC As String
Dim strADN As String, strAPW As String, strRDB As String

Dim intLmonth As Integer, intTmonth As Integer
Dim lngFindRow As Long, lngLyear As Long, lngTyear As Long
Dim dteLmonth As Date, dteTmonth As Date, dteWsData As Date
Dim Varhols As Variant

Application.ScreenUpdating = False
Application.DisplayAlerts = False

'The following section is for setting the date variables for testing whether we are
'in the same year and month, before setting the route directory of the all deals
'sheet and individual broker sheets

strDealsDte = Format(Now(), "dd-mmm-yy")
Varhols = Worksheets("Bank Holidays").Range("a1:a50")
dteWsData = workday(Date, -1, Varhols)
dteLmonth = workday(Date, -1, Varhols)
dteTmonth = workday(Date, 0, Varhols)
intLmonth = Format(dteLmonth, "m")
intTmonth = Format(dteTmonth, "m")
lngLyear = Format(dteLmonth, "yyyy")
lngTyear = Format(dteTmonth, "yyyy")

'This section uses the preset date variables to open the correct all deals sheet and
'then set the correct route directory for each dealer

If lngLyear < lngTyear Then
    strAllDealsRte = " Data:Dealing instructions:All Deals:" & lngLyear & ":"
    strPMAllDeals = "All Deals " & Format(dteLmonth, "mm-yy")
    strOpenAllDeals = strAllDealsRte & strPMAllDeals
    Workbooks.Open FileName:=strOpenAllDeals, ReadOnly:=False
    strLmonth = Format(dteLmonth, "mmmm")
    Set objWSKADeals = ActiveWorkbook.Worksheets(strLmonth & " deals")
    strDealsShtRte = " Data:Dealing instructions:" & lngLyear & ":Deals " _
    & Format(dteLmonth, "mm-yy") & ":Dealing by "

ElseIf lngLyear = lngTyear Then
    
    strAllDealsRte = " Data:Dealing instructions:All Deals:" & lngTyear & ":"
    
    If intLmonth < intTmonth Then
        strPMAllDeals = "All Deals " & Format(dteLmonth, "mm-yy")
        strOpenAllDeals = strAllDealsRte & strPMAllDeals
        Workbooks.Open FileName:=strOpenAllDeals, ReadOnly:=False
        strLmonth = Format(dteLmonth, "mmmm")
        Set objWSKADeals = ActiveWorkbook.Worksheets(strLmonth & " deals")
        strDealsShtRte = " Data:Dealing instructions:" & lngTyear & ":Deals " _
        & Format(dteLmonth, "mm-yy") & ":Dealing by "
        
    ElseIf intLmonth = intTmonth Then
        strTAllDeals = "All Deals " & Format(dteTmonth, "mm-yy")
        strOpenAllDeals = strAllDealsRte & strTAllDeals
        Workbooks.Open FileName:=strOpenAllDeals, ReadOnly:=False
        strTmonth = Format(dteTmonth, "mmmm")
        Set objWSKADeals = ActiveWorkbook.Worksheets(strTmonth & " deals")
        strDealsShtRte = " Data:Dealing instructions:" & lngTyear & ":Deals " _
        & Format(dteTmonth, "mm-yy") & ":Dealing by "
        
    End If
End If
'The following section sets the string values to complete the route directory and
'the consolidation sequences

strADN = "AndrewN "
strAPW = "AndrewW "
strRDB = "Rob "
strConsolA = strDealsShtRte & strADN & Format(dteWsData, "dd-mm-yy")
strConsolB = strDealsShtRte & strAPW & Format(dteWsData, "dd-mm-yy")
strConsolC = strDealsShtRte & strRDB & Format(dteWsData, "dd-mm-yy")

'opens the each of the individual broker sheets and consolidates the data to the
'all deals sheets this section also deletes any unrequired deal sheets
Workbooks.Open FileName:=strConsolA, ReadOnly:=False
Set objADNdeals = Worksheets(strADN)
objADNdeals.Select
lngFindRow = objADNdeals.Range("b250").End(xlUp).Row
If lngFindRow < 7 Then lngFindRow = 7
    Set rngADNdeals = objADNdeals.Range("b7:b" & lngFindRow)
    If WorksheetFunction.CountA(rngADNdeals) = 0 Then
    ActiveWorkbook.Close
    Kill (strConsolA)
Else
    For Each rngADNdeal In rngADNdeals
        Sheets(rngADNdeal.Parent.Name).Cells(rngADNdeal.Row, 1).Range("b1:p1").Copy
        objWSKADeals.Range("c65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
        objWSKADeals.Range("c65536").End(xlUp).Offset(0, -1) = strADN
        objWSKADeals.Range("c65536").End(xlUp).Offset(0, -2) = Format(dteWsData, "dd-mmm-yy")
        Next rngADNdeal
        ActiveWorkbook.Close savechanges:=False
End If
ActiveWorkbook.Save

Workbooks.Open FileName:=strConsolB, ReadOnly:=False
Set objAPWdeals = Worksheets(strAPW)
objAPWdeals.Select
lngFindRow = objAPWdeals.Range("b250").End(xlUp).Row
If lngFindRow < 7 Then lngFindRow = 7
    Set rngAPWdeals = objAPWdeals.Range("b7:b" & lngFindRow)
    If WorksheetFunction.CountA(rngAPWdeals) = 0 Then
    ActiveWorkbook.Close
    Kill (strConsolB)
Else
For Each rngAPWdeal In rngAPWdeals
    Sheets(rngAPWdeal.Parent.Name).Cells(rngAPWdeal.Row, 1).Range("b1:p1").Copy
    objWSKADeals.Range("c65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
    objWSKADeals.Range("c65536").End(xlUp).Offset(0, -1) = strAPW
    objWSKADeals.Range("c65536").End(xlUp).Offset(0, -2) = Format(dteWsData, "dd-mmm-yy")
    Next rngAPWdeal
    ActiveWorkbook.Close savechanges:=False
End If
ActiveWorkbook.Save

Workbooks.Open FileName:=strConsolC, ReadOnly:=False
Set objRDBdeals = Worksheets(strRDB)
objRDBdeals.Select
lngFindRow = objRDBdeals.Range("b250").End(xlUp).Row
If lngFindRow < 7 Then lngFindRow = 7
    Set rngRDBdeals = objRDBdeals.Range("b7:b" & lngFindRow)
    If WorksheetFunction.CountA(rngRDBdeals) = 0 Then
    ActiveWorkbook.Close
    Kill (strConsolC)
Else
    For Each rngRDBdeal In rngRDBdeals
    Sheets(rngRDBdeal.Parent.Name).Cells(rngRDBdeal.Row, 1).Range("b1:p1").Copy
    objWSKADeals.Range("c65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
    objWSKADeals.Range("c65536").End(xlUp).Offset(0, -1) = strRDB
    objWSKADeals.Range("c65536").End(xlUp).Offset(0, -2) = Format(dteWsData, "dd-mmm-yy")
    Next rngRDBdeal
    ActiveWorkbook.Close savechanges:=False
End If
ActiveWorkbook.Save

'The following section sets the printarea to print the previous days deals

objWSKADeals.Activate
Set rngAllSheet = objWSKADeals.Range("a2:a" & objWSKADeals.Range("a65536").End(xlUp).Row)
Set rngFoundDeal = rngAllSheet.Find(what:=DateValue(Format(dteWsData, "dd-mmm-yy")))
If Not rngFoundDeal Is Nothing Then
    strFirstAddress = rngFoundDeal.Address
Do
    rngFoundDeal.Activate
Set rngFoundDeal = rngAllSheet.FindNext(rngFoundDeal)
If rngFoundDeal.Address <> strFirstAddress Then
    Set rngLastAddress = rngFoundDeal
ElseIf rngFoundDeal.Address = strFirstAddress Then
    Set rngLastAddress = ActiveCell
    Exit Do
End If
Loop
objWSKADeals.PageSetup.PrintArea = strFirstAddress & ":$o$" & rngLastAddress.Row
objWSKADeals.PrintOut
End If
ActiveWorkbook.Close savechanges:=True

end sub

I look forward to your replies

Kindest Regards

Andrew

 

[Bozacke]

Hi Andrew,

There is code to run a macro at a specific time, but I'm not too sure if it will work for Mon-Friday. A much easier and cleaner method is to set the macro up as an Autpen macro and then schedule a task to run the file every Mon-Frday at a specific time. Simply rename the macro as Autpen, this will run the macro when you open the file and then in the control panel select Sceduled task and add a new scheduled task, select your file and assign the time and days.

 

[cmmadn]

Hi

Thanks for the info, however, I am working on a Mac and I do not think I has the facility to schedule tasks javascript:emoticon('') any ideas?

Kindest Regards

Andrew