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!

 

[Dancing_Bear_101]

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.

I appreciate your prompt response, frankly you are speaking gibberish to me, that's how novice I am when it comes to macros.

From a root cause perspective, do you think it has to do with an error in the column header? What other information can I provide you with so we can resolve said error?

 

[Dancing_Bear_101]

colSource = Split(cell.Address, "$")(2)

Do I have to manually input anything within code above? Based on column header that is.

 

[Zot]

colSource = Split(cell.Address, "$")(2)

Do I have to manually input anything within code above? Based on column header that is.

My assumption is that on both sheets in Source and Final workbook have titles starting from range A1.

The loop
For Each cell In rngHeaderSource and also For Each cell In rngHeaderFinal is looping through A1, B1, C1 and automatically extract column letter, such as A, B, C, D, etc.
The cell.Address will get address in form $A$1, $B$1, etc. The colSource = Split(cell.Address, "$") (1) will extract A, B, C, D etc. If there is no matching it will leave colSource blank.

I was surprised to see the execution stopped at that location. Looks like it has found match but stopped there. I cannot think of the reason. That is why I wanted you to paste your actual sheet to see how it looks like. Using the tool provided in this forum XL2BB (the right most icon on reply box). This will install tool that able you to select range to capture and paste here. Once pasted it looks like rubbish but if you press Preview, you wull see the actual outcome. You need to press Preview back to return to writing mode.

Other option is to upload to DropBox or Google or whatever sharing media so that I can have a mock up file of real workbook. This shouldn't be a difficult macro.

NOte: Funny that Open Bracket + n + Close Bracket becomes -- Bad ?

 

[Dancing_Bear_101]

My assumption is that on both sheets in Source and Final workbook have titles starting from range A1.

The loop
For Each cell In rngHeaderSource and also For Each cell In rngHeaderFinal is looping through A1, B1, C1 and automatically extract column letter, such as A, B, C, D, etc.
The cell.Address will get address in form $A$1, $B$1, etc. The colSource = Split(cell.Address, "$") (1) will extract A, B, C, D etc. If there is no matching it will leave colSource blank.

I was surprised to see the execution stopped at that location. Looks like it has found match but stopped there. I cannot think of the reason. That is why I wanted you to paste your actual sheet to see how it looks like. Using the tool provided in this forum XL2BB (the right most icon on reply box). This will install tool that able you to select range to capture and paste here. Once pasted it looks like rubbish but if you press Preview, you wull see the actual outcome. You need to press Preview back to return to writing mode.

Other option is to upload to DropBox or Google or whatever sharing media so that I can have a mock up file of real workbook. This shouldn't be a difficult macro.

NOte: Funny that Open Bracket + n + Close Bracket becomes -- Bad ?

So does it matter that the columns from Source dont match up to columns in Final related to column? Meaning, there are some columns which are added to Final sheet that are populated by formulas (bolded columns).

Example below:

Source:

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:

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

 

[Zot]

I'm so sorry. My code could have not work like that.

Here is the corrected one. Probably can have simpler and better but this is very straight forward and easy for you to modify. This will work. This time I've tested it. Sorry for wasting your time

Sub CopySource2Final()

Dim n As Long, m As Long
Dim colSource(11) As String, colFinal(11) As String    ' Array count starts from 0 ~ 10. Change if you add more columns.
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))

' 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

n = -1
' Find and define column letter for Source
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

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

End Sub

 

[Zot]

Oh forget to tell that ... Yes, it does not matter order of the column titles in row 1