Forum Discussion

jpage's avatar
jpage
Copper Contributor
Dec 13, 2024

Help Creating a Macro

I have a file that has multiple tabs I want to update.

The destination file has original tab named and the source files have different names.

I want to do this essentially:

Destination file: Campaign Reference

Tabs: NF APT, NF ROLLING APT, APT, ROLLING APT, FALL, WINTER, SUMMER

 

Source files: Food promo wkXX DATE(changes weekly), Rolling APT DATE (date changes weekly), fall, winter, and summer campaign files.

 

I only want to put certain columns from the campaign files and potentially filter one of the APT files. Example would be the promo week being 50/24 only.

 

If it is possible I want to make it one click and update with maybe a dialogue box for the filter.

  • Take this:

     

    Sub UpdateCampaignReference()
        Dim wsDest As Worksheet
        Dim wsSource As Worksheet
        Dim sourceFile As Workbook
        Dim folderPath As String
        Dim fileName As String
        Dim promoWeek As String
    
        ' Folder path containing source files
        folderPath = ThisWorkbook.Path & "\"
    
        ' Destination Worksheet
        Set wsDest = ThisWorkbook.Sheets("Campaign Reference")
        
        ' Prompt user for promo week filter
        promoWeek = InputBox("Enter promo week filter (e.g., 50/24):")
    
        ' Source files
        fileNames = Array("Food promo wk", "Rolling APT", "fall", "winter", "summer campaign")
    
        For Each file In fileNames
            fileName = Dir(folderPath & file & "*.xlsx")
            If fileName <> "" Then
                ' Open source file
                Set sourceFile = Workbooks.Open(folderPath & fileName)
                
                ' Update corresponding tab in destination file
                For Each wsSource In sourceFile.Worksheets
                    Select Case wsSource.Name
                        Case "NF APT", "NF ROLLING APT", "APT", "ROLLING APT", "FALL", "WINTER", "SUMMER"
                            If wsSource.Name Like "NF*" Or wsSource.Name Like "APT*" Then
                                ' Apply filter for promo week if applicable
                                wsSource.AutoFilterMode = False
                                wsSource.Range("A1").AutoFilter Field:=1, Criteria1:=promoWeek
                            End If
                            ' Copy specified columns from source to destination
                            wsSource.Range("A:A, C:C, E:E").Copy wsDest.Cells(wsDest.Rows.Count, 1).End(xlUp).Offset(1, 0)
                    End Select
                Next wsSource
    
                ' Close source file
                sourceFile.Close SaveChanges:=False
            End If
        Next file
    
        MsgBox "Campaign Reference updated successfully!"
    End Sub
    

     

Resources