Run Macro using batch file

Fatman003

New Member
Joined
Aug 22, 2019
Messages
19
I have a macro that I would like to run externally using a bat file. I would have done this using vbs but with the company policy it doesnt work. Here is my code below. I want the code to be run externally because in the coming months, I wont be the one to run the code and I would like to make it easier for the person to run it. As you can also see from my code, the workbook will need to be opened so the Active sheet can work. Please help!

Code:
Sub Fatman()
    Dim k As Long, Date1 As Date
    Dim rng As Range
    
	'Adding borders to the additional columns
	'lrr = Cells(Rows.Count, "AD").End(xlUp).Row
    Set rng = Range("AD:AM")' & lrr)
    With rng.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 0
        .TintAndShade = 0
    End With
	
    'Creating columns names    
    Cells(1, 30) = "Months"
    Cells(1, 31) = "Age"
    Cells(1, 32) = "Sector CD"
    Cells(1, 33) = "Departement CD"
    Cells(1, 34) = "Secteur CD"
    Cells(1, 35) = "Department CD"
    Cells(1, 36) = "Sector Originator"
    Cells(1, 37) = "Department Originator"
    Cells(1, 38) = "CD all"
    Cells(1, 39) = "sign RD"
    
    'Aligning the cells 
	
	Columns("AK").AutoFit
	Columns("AG").AutoFit
    Columns("AJ").AutoFit
    Columns("A:AM").HorizontalAlignment = xlCenter
	Columns("AD:AM").Font.Name = "Arial"
    Columns("AD:AM").Font.Size = 8
	Columns.Range("AD1", "AE1").Interior.Color = Excel.XlRgbColor.rgbGray
	Columns.Range("AJ1", "AK1").Interior.Color = Excel.XlRgbColor.rgbLightGreen
    Columns.Range("AH1", "AI1").Interior.Color = Excel.XlRgbColor.rgbLightBlue
    Columns.Range("AL1", "AM1").Interior.Color = Excel.XlRgbColor.rgbLightGray
    Columns.Range("AF1", "AG1").Interior.Color = Excel.XlRgbColor.rgbLightGray
	
	'Creating the VLookUp
    Dim Ary As Variant, Nary As Variant
    Dim i As Long
	Dim Sheet1 As Worksheet
    
	Set ws = ActiveSheet
    Ary = Sheets("RD coordinator department pivot").Range("A1").CurrentRegion.Value2
    With CreateObject("scripting.dictionary")
        For i = 2 To UBound(Ary)
            .Item(Ary(i, 1)) = Array(Ary(i, 7), Ary(i, 8), Ary(i, 5), Ary(i, 6))
        Next i
        Ary = ws.Range("S2", ws.Range("V" & Rows.Count).End(xlUp)).Value2
        ReDim Nary(1 To UBound(Ary), 1 To 8)
        For i = 1 To UBound(Ary)
            If .exists(Ary(i, 4)) Then
                Nary(i, 1) = .Item(Ary(i, 4))(0)
                Nary(i, 2) = .Item(Ary(i, 4))(1)
                Nary(i, 7) = .Item(Ary(i, 4))(2)
                Nary(i, 8) = .Item(Ary(i, 4))(3)
            End If
            If .exists(Ary(i, 1)) Then
                Nary(i, 3) = .Item(Ary(i, 1))(0)
                Nary(i, 4) = .Item(Ary(i, 1))(1)
            End If
        Next i
        ws.Range("AF2").Resize(UBound(Nary), 8).Value = Nary
    End With
	
	lr = Cells(Rows.Count, "B").End(xlUp).Row
    Date1 = Date
    For k = 2 To lr
        Cells(k, 36).Value = Left(Cells(k, 9).Value, 2) 'Applying LEFT function to column I
        Cells(k, 37).Value = Left(Cells(k, 9).Value, 4)
        Cells(k, 30).Value = DateDiff("M", Cells(k, 2), Date1) 'Date diff between column B and current date
        'For the Aging column 
        If Cells(k, 30).Value < 6 Then
            Cells(k, 31).Value = "1 - less than 6 month"
        ElseIf Cells(k, 30).Value >= 6 And Cells(k, 30).Value < 12 Then
            Cells(k, 31).Value = "2 - Between 6 and 12 months"
        ElseIf Cells(k, 30).Value >= 12 And Cells(k, 30).Value < 36 Then
            Cells(k, 31).Value = "3 - Between 1 and 3 years"
        Else
            Cells(k, 31).Value = "4 -  more than 3 years"
        End If
        
    Next k
	Columns("AE").EntireColumn.AutoFit
End Sub

If needed, the location of the wokbook could be something like C:/Users/F65866/monthly CD/task.xlsx
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Forum statistics

Threads
1,213,561
Messages
6,114,317
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top