Macro to run a piece of code depending on the active workbook name

[AndyM90]

Hi All,

I have a 8 macros I use every morning which simply select the last used column and copies the data into the next available column:

Sheets("PL").Activate


Dim i As Long
i = Cells(1, Columns.Count).End(xlToLeft).Column
Columns(i).Copy Destination:=Cells(1, i + 1)


With Cells(1, i + 1)
    .Formula = "=WORKDAY(NOW(),-1)"
    .Value = .Value
End With


End Sub

and the below is another example:

ActiveWorkbook.Sheets("EUR").Activate


Dim i As Long
i = Cells(1, Columns.Count).End(xlToLeft).Column
Columns(i).Copy Destination:=Cells(1, i + 1)


With Cells(1, i + 1)
    .Formula = "=WORKDAY(NOW(),-1)"
    .Value = .Value
End With


Sheets("GBP").Activate


i = Cells(1, Columns.Count).End(xlToLeft).Column
Columns(i).Copy Destination:=Cells(1, i + 1)




With Cells(1, i + 1)
    .Formula = "=WORKDAY(NOW(),-1)"
    .Value = .Value
End With


Sheets("NOK").Activate




i = Cells(1, Columns.Count).End(xlToLeft).Column
Columns(i).Copy Destination:=Cells(1, i + 1)


With Cells(1, i + 1)
    .Formula = "=WORKDAY(NOW(),-1)"
    .Value = .Value
End With


Sheets("USD").Activate




i = Cells(1, Columns.Count).End(xlToLeft).Column
Columns(i).Copy Destination:=Cells(1, i + 1)




With Cells(1, i + 1)
    .Formula = "=WORKDAY(NOW(),-1)"
    .Value = .Value
End With


Sheets("EUR").Activate


End Sub

There are seven other varieties of this in different workbooks which essentially does the same thing (see the code above, some are for multiple worksheets). I've assigned all of these macros a shortcut (ctrl+q) however if I have two spreadsheets open the macro fails as it looks for the wrong spreadsheet.

Is there a way I can put all of these macros together in one sub and have the code look up the active workbook name, then run a set piece of the code?

Thanks!

 

[Darren Bartrup]

Hi Andy,

You can specify the workbook and worksheet for the code to run on easily enough.

Where you're putting Columns, Cells, etc - these all work on the activesheet.
If you tell it which workbook and worksheet to act on you can easily have the same piece of code run on all open workbooks.

NB: ThisWorkbook means the file that the code is in.

The With wrksht line of code tells the code between the With and End With statements to look at wrksht every time there's a full-stop (period).
It's the same as writing wrkSht.Columns(1).Copy Destination:=wrkSht.Cells(1, 5)

NB 2: You don't need to activate the sheet to run code on it, just need to reference it.

Sub Use_On_Different_WorkSheets()

    Do_Stuff_On_Specified_WorkSheet ThisWorkbook.Worksheets("Sheet1")
    Do_Stuff_On_Specified_WorkSheet Workbooks("Book2.xlsx").Worksheets("Sheet1")

End Sub


Sub Do_Stuff_On_Specified_WorkSheet(wrkSht As Worksheet)


    With wrkSht
        .Columns(1).Copy Destination:=.Cells(1, 5)
    End With


End Sub

 

[Joe4]

Also note that if you remove all references of sheet names from your code, the code will just run on whatever the active workbook is at the time of running, regardless of its name.

 

[AndyM90]

Sorry if i'm being a dunce Darren, but I dont think i've explained myself to well (or i'm misreading your advice).

Lets say I have 5 workbooks (workbook A, workbook B... workbook E). workbook A, B and C only have one worksheet, where as D and E have 10 worksheets - but only 3 of the worksheets (1 4 and 6) require a new column to be added - so my code specifies these worksheets.

Currently, I have 5 different macros to work in the 5 different workbooks with a shortcut of ctrl+Q which works for all of them (for the users ease). However, if the user has workbook A and D open for example, the macro fails because the macro may look at workbook A to find the additional sheets.

Ideally, i would like to put all the macros together and so the logic is as per the below:

1) What workbook is the user activating this macro from?
2) Is this workbook A? If not A, then is it B? If not B, is it C? etc
3) Once it identifies the workbook, run the macro associated to the name of that workbook?

Forgive me if that is what you have explained above.

Thanks,

Andy

 

[Darren Bartrup]

ok, think I've got it.

Something like:

Public Sub Main()    
    Select Case ActiveWorkbook.Name
        Case "Book A.xls", "Book B.xls", "Book C.xls"
            CopyColumns ActiveWorkbook, Array("Sheet1")


        Case "Book D.xls", "Book E.xls"
            CopyColumns ActiveWorkbook, Array("Sheet1", "Sheet2", "Sheet3")
            
        Case Else
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            'Do nothing - the active workbook isn't one of the files. '
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            
    End Select


End Sub


Public Sub CopyColumns(wrkBk As Workbook, SheetNames As Variant)
    
    Dim x As Long
    Dim wrkSht As Worksheet
    Dim rLastCell As Range
    
    For x = LBound(SheetNames) To UBound(SheetNames)
        Set wrkSht = wrkBk.Worksheets(SheetNames(x))
        Set rLastCell = LastCell(wrkSht)
        wrkSht.Columns(rLastCell.Column).Copy _
            Destination:=wrkSht.Cells(1, rLastCell.Column + 1)
    Next x


End Sub


Public Function LastCell(wrkSht As Worksheet, Optional Col As Long = 0) As Range


    Dim lLastCol As Long, lLastRow As Long
    
    On Error Resume Next
    
    With wrkSht
        If Col = 0 Then
            lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            lLastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        Else
            lLastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            lLastRow = .Columns(Col).Find("*", , , , xlByColumns, xlPrevious).Row
        End If
        
        If lLastCol = 0 Then lLastCol = 1
        If lLastRow = 0 Then lLastRow = 1
        
        Set LastCell = wrkSht.Cells(lLastRow, lLastCol)
    End With
    On Error GoTo 0
    
End Function

 

[dmt32]

Lets say I have 5 workbooks (workbook A, workbook B... workbook E). workbook A, B and C only have one worksheet, where as D and E have 10 worksheets - but only 3 of the worksheets (1 4 and 6) require a new column to be added - so my code specifies these worksheets.

If your worksheets 1,4,6 are the sheets tab numbers (Index) then you should be able to use this rather than the tab names to pass a common procedure based on your code.

see if following is of any help to you:

code to assign shortcut key:

Sub CopyColumn()
    Dim arr As Variant
    Dim sh As Worksheet
    Dim i As Integer
    
    'shortcut keys ctrl+Q


    arr = Array(1, 4, 6)
    
    On Error Resume Next
    For i = 0 To UBound(arr)
        Set sh = ActiveWorkbook.Worksheets(CInt(arr(i)))
        If Err = 0 Then CopyColumnData sh:=sh
        Err.Clear
    Next i
End Sub

Common procedure based on your code:

Sub CopyColumnData(ByVal sh As Object)
    Dim i As Long
    i = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
    sh.Columns(i).Copy Destination:=sh.Cells(1, i + 1)
    With sh.Cells(1, i + 1)
        .Formula = "=WORKDAY(NOW(),-1)"
        .Value = .Value
    End With
End Sub

Above not tested but code should work with the Active workbook & update either a workbook containing 1 sheet or more (10). It is important though that the specified worksheet indexes (shown in array) are in their correct numeric place in workbooks that contain more than 1 worksheet.

Hope Helpful

Dave