VBA to copy columns from one workbook to another based on column title. Source workbook name changes every new download.

[Dancing_Bear_101]

Background: This is my first time dealing with macros. I will have two workbooks that I’ll be using. The first workbook (will call it Source) contains data source which is downloaded daily and workbook name changes, but the worksheet name remains the same "HOTT Detailed Module". The second workbook (will call it Final) will have data available formatted as a table under "HOTT Detailed Module" worksheet, which will need to be updated using the data copied from the first workbook based on matching column titles.

* I want the macro to copy the specified columns in the ‘Source’ workbook based on column title, copy that data in said specified columns all the way down to the last row of existing data (instead of the entire column), and paste it onto the ‘Final’ workbook under the same column title.

The reason why I have to specify which headers to find is because the headers in the ‘Source’ workbook don't match up exactly in terms of positioning with the "Final" workbook, for there have been manual column added to the destination table within the "Final" workbook.

Source workbook example:

Created On Date

Sold-To

Sold-To Name

Sales Document

Customer PO

Delivery Block

Billing Block

Order Description

Contact Person

Latest Delivery Date

First Date of Sales Item

Final workbook example:

1. Columns in bold have been manually added

Created On Date

Year

21+

Sold-To

Sold-To Name

Sales Document

Customer PO

Delivery Block

Billing Block

Order Description

Contact Person

Latest Delivery Date

First Date of Sales Item

Order Block

I want macro to recognize that the columns need to be pasted within the correct columns based on column title. For if columns get pasted incorrectly, the whole model within the second "Final" workbook will fail.

I’m sorry if my wording isn’t accurate – I tried to explain the best I could. It’d be awesome if someone could help me out on this! Thanks!

 

[Zot]

The code provided can be simplified/shortened by more looping I suppose but writing it this way made it easy to understand the flow and easy to tweak to your need. When the macro is run, it will ask for Source file and execute the rest of the program.

Sub CopySource2Final()

Dim n As Long
Dim colSource(11) As String, colFinal(11) As String
Dim cell As Range, rngHeaderSource As Range, rngHeaderFinal As Range, rngCopy As Range
Dim Fname As Variant
Dim wsSource As Worksheet, wsFinal As Worksheet
Dim wbSource As Workbook, wbFinal As Workbook
Dim rngTotal As Range

Application.ScreenUpdating = False

' Define this Workbook as wbFinal
Set wbFinal = ActiveWorkbook
' Define working sheet in wbFinal. Change sheet name accordingly
Set wsFinal = wbFinal.Sheets("HOTT Detailed Module")

' Open Source Workbook
Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls; *.xlsx; *.xlsm; *.xlsb), *.xls; *.xlsx; *.xlsm; *.xlsb", Title:="Select a File")
If Fname = False Then Exit Sub                         'CANCEL is clicked

' Define opened Workbook as wbSource while opening it.
Set wbSource = Workbooks.Open(Filename:=Fname, UpdateLinks:=False, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
' Define working sheet in wbSource. Change sheet name accordingly
Set wsSource = wbSource.Sheets("HOTT Detailed Module")

' Define header range in Source workbook. Assuming on row1 (Change if required)
Set rngHeaderSource = wsSource.Range("A1", wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft))

' Find and define column letter for Source
n = -1
For Each cell In rngHeaderSource
    Select Case cell
        Case "Created On Date"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Sold-To"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Sold-To Name"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Sales Document"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Customer PO"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Delivery Block"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Billing Block"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Order Description"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Contact Person"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "Latest Delivery Date"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
        Case "First Date of Sales Item"
            n = n + 1
            colSource(n) = Split(cell.Address, "$")(1)
    End Select
Next

' Define header range in Final workbook. Assuming on row1 (Change if required)
Set rngHeaderFinal = wsFinal.Range("A1", wsFinal.Cells(1, wsFinal.Columns.Count).End(xlToLeft))

' Find and define column letter for Final
n = -1
For Each cell In rngHeaderFinal
    Select Case cell
        Case "Created On Date"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Sold-To"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Sold-To Name"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Sales Document"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Customer PO"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Delivery Block"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Billing Block"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Order Description"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Contact Person"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "Latest Delivery Date"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
        Case "First Date of Sales Item"
            n = n + 1
            colFinal(n) = Split(cell.Address, "$")(1)
    End Select
Next

' Transfer data from Source to Final
For n = 0 To 10
    wsSource.Range(colSource(n) & 2, Cells(wsSource.Rows.Count, colSource(n)).End(xlUp)).Copy wsFinal.Range(colFinal(n) & "2")
Next

End Sub

 

[Dancing_Bear_101]

Forgive my ignorance for this would mark my first time ever using a macro, but I would simply copy the code provided when opening the source file? Do I have to have both files open?

 

[Zot]

Forgive my ignorance for this would mark my first time ever using a macro, but I would simply copy the code provided when opening the source file? Do I have to have both files open?

The code should be copied into normal module of the wbFinal. Run the program and it will ask for location file. Browse to the file and it will continue run until complete the task.

 

[Dancing_Bear_101]

If I needed to add more columns, I can just build on the code?

 

[Zot]

If I needed to add more columns, I can just build on the code?

Just keep adding following the pattern in both Select Cases

 

[Dancing_Bear_101]

View attachment 42953

I went ahead and ran, and the following error occured.

Also, where you state "Define header range in Source workbook. Assuming on row1 (Change if required)"

All I did was update where the columns began from both wbSource and WbFinal. Is that correct?

 

[Zot]

Sorry. I was away. My office is currently under lockdown area due to Covid-19 and is closed until Aug . I did not able to download your sample as it is not no more there.

' Define header range in Source workbook. Assuming on row1 (Change if required)
Set rngHeaderSource = wsSource.Range("A1", wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft))

In
Set rngHeaderSource = wsSource.Range("A1", wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft))

The A1 is start column and row

the
wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft)

The 1 is for row 1 and the line above acts like you select last column on worksheet row 1. Press CTRL + ArrowLeft. The cursor will stop on last occupied cell on row 1 (which is suppose to be last column of headers)

So, you may change A1 for start column and 1 for whatever row. Note that the row must match the start column row.

 

[Dancing_Bear_101]

I get the following error:

Please advice after I select debug:

 

[Zot]

Something to do with variable not found. How is your sheet looks like?

I think you should install XL2BB (one of the icon in the row here. Just click it) and use it to copy paste the range you want to capture and paste. You can click Preview on how the result would be and click Preview again to retun to reply mode.