Auto-Copy date in from spreadsheets, if HEADINGS match... rather than copy/pasting (can't do macro/VBA)

[sneeky]

Ok, firstly i have no experience with macro much or vba.
we have many spreadsheets; now rather than copy pasting.. surely if the headings match.. then a formula should be able to copy the data underneath into the master sheet automatically or with less effort with index/match, hlookup or something formula...

would save so much bloody time...!

 

[sergioMabres]

Hi Sneeky,
So if I am not mistaken you need a macro to copy data of columns from work sheets to the master sheet using column heading match as a guide
I have done some of these macros, and although they are very similar one another they are not all equal, most of the time they change according to the shape and sizes of the sheets.
What do you need?
Cheers
Sergio

 

[sneeky]

Got im really new to macros and vba. I can perhaps send u my spreadsheet removing confidential data; and u can tailor the macro and tell as simply as possible how to use the macro etc. Are u on WhatsApp, Facebook or something. . So I can talk to u. I started this job and easy at the moment but will get harder. ..I really could do with your help. U want to send me a msg in private with details? Thx sergio

 

[sneeky]

God* I mean

 

[sergioMabres]

Hi Sneeky,
Here is a code that will copy columns from a data file to a master file using column heading as guide to find correspondence
You should place the code in a Master.xlsm open both files data and master, go to (activate) data file and run this macro

Sub copy2master()
'
' Open both files Master (mf) and Data (cf)
' Go to the data file and run this macro
' Click or select Macros you will see this
' macro as 'Master.xlsm'!copy2master click on run
'
    ' Define names of files and sheets so it is easier when they change
    Dim mf, cf, key As String
    Dim lr, lc, lrcf, lccf, y1, x1, y2, y4, x4 As Long
    Dim Wbmf As Workbook
    Dim mc As Range
    mf = "MASTER-v2.xlsm"
    cf = ActiveWorkbook.Name
    ' Finds last used row in master file (mf) also it deactivates screen updates
    Application.ScreenUpdating = False
    Windows(mf).Activate
    Set Wbmf = ActiveWorkbook
    lr = Range("A1").CurrentRegion.Rows.Count + 1
    lc = Range("A1").CurrentRegion.Columns.Count
    Set mc = Range(Range("A1"), Range("A1").Offset(0, lc - 1))
    ' Finds number of columns in cf
    Windows(cf).Activate
    lccf = Range("A1").CurrentRegion.Columns.Count
    lrcf = Range("A1").CurrentRegion.Rows.Count
    ' Loop thru all columns of cf
    For i = 1 To lccf
        ' Gets column heading
        key = Range("A1").Offset(0, i - 1).Value
        ' Gets corresponding column number using name as key in master sheet (mf)
        kc = 0
        On Error Resume Next
        kc = mc.Find(key, LookIn:=xlValues, LookAt:=xlWhole).Column
        '
        ' If kc is > 0 it has found a corresponding column in master file will copy and paste
        ' if kr = 0 then it means that column in data file is new and WILL NOT BE processed
        ' not added at the end of the master file, it can be done but this code does not
        ' Actually when a value is not found an error 91 is thrown that is why on error is used
        '
        ' If in the data file (cf) there are two columns with the same column heading
        ' the second occurrance will paste over the first so you will see only the second
        '
        If kc > 0 Then
            ' Calcs range origin and destination
            y1 = 1
            x1 = i - 1
            y2 = lrcf - 1
            y4 = lr - 1
            x4 = kc - 1
            ' Copy range
            Range(Range("A1").Offset(y1, x1), Range("A1").Offset(y2, x1)).Copy
            ' Activate master sheet and Paste range to cell
            Windows(mf).Activate
            Range("A1").Offset(y4, x4).PasteSpecial _
               Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Windows(cf).Activate
        End If
        ' Process next column in data file (cf)
    Next i
    ' it activates screen updates
    Application.ScreenUpdating = True
End Sub

I have copiously commented the code so to make it easier for you to understand
I hope it helps with your problem
Cheers
Sergio

 

[sergioMabres]

Hi Sneeky,
I was thinking about two issues with the code:
1) New Column Heading, that is to say Heading in the data files but not in the master file, well this new code will write these new columns in the far right end of the master sheet, and also
2) I solved the problem if data files have a second row of heading that should not be copied.

Sub copy2master()
'
' Open both files Master (mf) and Data (cf)
' Go to the data file and run this macro
' Click or select Macros you will see this
' macro as 'Master.xlsm'!copy2master click on run
'    v1 User's version
'    v2 Copies matching headers columns initial version
'    v3 Data files have a 2nd row that should not be copied
'       If new columns are found they will be copied at the right end of master file

    ' Define names of files and sheets so it is easier when they change
    Dim mf, cf, key As String
    Dim lr, lc, lrcf, lccf, y1, x1, y2, y4, x4 As Long
    Dim Wbmf As Workbook
    Dim mc As Range
    mf = "MASTER-v3.xlsm"
    cf = ActiveWorkbook.Name
    ' Finds last used row in master file (mf) also it deactivates screen updates
    Application.ScreenUpdating = False
    Windows(mf).Activate
    Set Wbmf = ActiveWorkbook
    lr = Range("A1").CurrentRegion.Rows.Count + 1
    lc = Range("A1").CurrentRegion.Columns.Count
    Set mc = Range(Range("A1"), Range("A1").Offset(0, lc - 1))
    ' Finds number of columns in cf
    Windows(cf).Activate
    lccf = Range("A1").CurrentRegion.Columns.Count
    lrcf = Range("A1").CurrentRegion.Rows.Count
    ' Loop thru all columns of cf
    For i = 1 To lccf
        ' Gets column heading
        key = Range("A1").Offset(0, i - 1).Value
        ' Gets corresponding column number using name as key in master sheet (mf)
        kc = 0
        On Error Resume Next
        kc = mc.Find(key, LookIn:=xlValues, LookAt:=xlWhole).Column
        '
        ' If kc is > 0 it has found a corresponding column in master file will copy and paste
        ' if kr = 0 then it means that column in data file is new and the macro will (v3) paste
        ' at the far right end of the master file
        ' (When a value is not found an error 91 is thrown that is why on error is used)
        '
        ' If in the data file (cf) there are two columns with the same column heading
        ' the second occurrance will paste over the first so you will see only the second
        '
        ' Calcs range origin and destination
        y1 = 2         ' v3: Do not include Second row (changed 1 for a 2)
        x1 = i - 1
        y2 = lrcf - 1
        y4 = lr - 1
        x4 = kc - 1
        ' Copy range
        Range(Range("A1").Offset(y1, x1), Range("A1").Offset(y2, x1)).Copy
        ' Activate master sheet and Paste range to cell
        Windows(mf).Activate
        If kc > 0 Then
            ' Column exists in master file
            Range("A1").Offset(y4, x4).PasteSpecial _
                Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Else
            ' Column does not exists in master file paste at the far end right
            ' Paste column heading
            Range("A1").Offset(0, lc).FormulaR1C1 = key
            Range("A1").Offset(y4, lc).PasteSpecial _
                Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            ' Updates lc for new coloumn
            lc = lc + 1
        End If
        Windows(cf).Activate
        ' Process next column in data file (cf)
    Next i
    ' it activates screen updates
    Application.ScreenUpdating = True
End Sub

Hope it helps with your problem
Cheers
Sergio

 

[sergioMabres]

Here is the last version, so this macro
1) Copies columns based on header name from selected range in data file to a MASTER file, I use selected range because it can be an all empty column in the data file and that should not break the input area.
2) Skips blanks and empty coll headers

Here is the code

Sub copy2master()
'
' Open both files Master (mf) and Data (cf)
' Go to the data file and select header area and run this macro
' Click or select Macros you will see this
' macro as 'Master.xlsm'!copy2master click on run
'    v1 User's version
'    v2 Copies matching headers columns initial version
'    v3 Data files have a 2nd row that should not be copied
'       If new columns are found they will be copied at the right end of master file
'    v4 Empty and blamk headers are not processed there is not matchig with blank or empty strings
'    v5 Area with informatio to copy from is discovered by selected range only
 
    ' Define names of files and sheets so it is easier when they change
    Dim mf, cf, key As String
    Dim lr, lc, lrcf, lccf, y1, x1, y2, y4, x4 As Long
    Dim Wbmf As Workbook
    Dim mc As Range
    mf = "MASTER.xlsm"
    cf = ActiveWorkbook.Name
    ' Finds number of columns in data file (cf) to copy using selected area
    lccf = Selection.Columns.Count
    If lccf < 2 Then
        rc = MsgBox("Please select a columns header range before calling this macro, " & _
                    "this macro needs a columns header range selected with more " & _
                    "than one column to count columns from.", _
                    vbOKOnly, "Error: No range was selected")
    Else
        ' Finds rows in cf with selected range
        lrcf = Selection.Rows.Count
        ' Finds last used row in master file (mf) also it deactivates screen updates
        Application.ScreenUpdating = False
        Windows(mf).Activate
        Set Wbmf = ActiveWorkbook
        lr = Range("A1").CurrentRegion.Rows.Count + 1
        lc = Range("A1").CurrentRegion.Columns.Count
        Set mc = Range(Range("A1"), Range("A1").Offset(0, lc - 1))
        ' Goes to cf
        Windows(cf).Activate
        ' Loop thru all columns of cf
        For i = 1 To lccf
            ' Gets column heading
            key = Range("A1").Offset(0, i - 1).Value
            ' There is no good way to handle empty column headers
            ' They will not be processed
            If key > " " Then    ' v4: Empty coll heading not processed
             ' Gets corresponding column number using name as key in master sheet (mf)
             kc = 0
             On Error Resume Next
             kc = mc.Find(key, LookIn:=xlValues, LookAt:=xlWhole).Column
             '
             ' If kc is > 0 it has found a corresponding column in master file will copy and paste
             ' if kr = 0 then it means that column in data file is new and the macro will (v3) paste
             ' at the far right end of the master file
             ' (When a value is not found an error 91 is thrown that is why on error is used)
             '
             ' If in the data file (cf) there are two columns with the same column heading
             ' the second occurrance will paste over the first so you will see only the second
             '
             ' Calcs range origin and destination
             y1 = 2         ' v3: Do not include Second row (changed 1 for a 2)
             x1 = i - 1
             y2 = lrcf - 1
             y4 = lr - 1
             x4 = kc - 1
             ' Copy range
             Range(Range("A1").Offset(y1, x1), Range("A1").Offset(y2, x1)).Copy
             ' Activate master sheet and Paste range to cell
             Windows(mf).Activate
             If kc > 0 Then
                 ' Column exists in master file
                 Range("A1").Offset(y4, x4).PasteSpecial _
                     Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             Else
                 ' Column does not exists in master file paste at the far end right
                 ' Paste column heading
                 Range("A1").Offset(0, lc).FormulaR1C1 = key
                 Range("A1").Offset(y4, lc).PasteSpecial _
                     Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                 ' Updates lc for new coloumn
                 lc = lc + 1
             End If
             Windows(cf).Activate
             ' Process next column in data file (cf)
            End If
        Next i
    End If
    ' it activates screen updates
    Application.ScreenUpdating = True
End Sub

 

[sneeky]

Here is the last version, so this macro
1) Copies columns based on header name from selected range in data file to a MASTER file, I use selected range because it can be an all empty column in the data file and that should not break the input area.
2) Skips blanks and empty coll headers

Here is the code

Sub copy2master()
'
' Open both files Master (mf) and Data (cf)
' Go to the data file and select header area and run this macro
' Click or select Macros you will see this
' macro as 'Master.xlsm'!copy2master click on run
'    v1 User's version
'    v2 Copies matching headers columns initial version
'    v3 Data files have a 2nd row that should not be copied
'       If new columns are found they will be copied at the right end of master file
'    v4 Empty and blamk headers are not processed there is not matchig with blank or empty strings
'    v5 Area with informatio to copy from is discovered by selected range only
 
    ' Define names of files and sheets so it is easier when they change
    Dim mf, cf, key As String
    Dim lr, lc, lrcf, lccf, y1, x1, y2, y4, x4 As Long
    Dim Wbmf As Workbook
    Dim mc As Range
    mf = "MASTER.xlsm"
    cf = ActiveWorkbook.Name
    ' Finds number of columns in data file (cf) to copy using selected area
    lccf = Selection.Columns.Count
    If lccf < 2 Then
        rc = MsgBox("Please select a columns header range before calling this macro, " & _
                    "this macro needs a columns header range selected with more " & _
                    "than one column to count columns from.", _
                    vbOKOnly, "Error: No range was selected")
    Else
        ' Finds rows in cf with selected range
        lrcf = Selection.Rows.Count
        ' Finds last used row in master file (mf) also it deactivates screen updates
        Application.ScreenUpdating = False
        Windows(mf).Activate
        Set Wbmf = ActiveWorkbook
        lr = Range("A1").CurrentRegion.Rows.Count + 1
        lc = Range("A1").CurrentRegion.Columns.Count
        Set mc = Range(Range("A1"), Range("A1").Offset(0, lc - 1))
        ' Goes to cf
        Windows(cf).Activate
        ' Loop thru all columns of cf
        For i = 1 To lccf
            ' Gets column heading
            key = Range("A1").Offset(0, i - 1).Value
            ' There is no good way to handle empty column headers
            ' They will not be processed
            If key > " " Then    ' v4: Empty coll heading not processed
             ' Gets corresponding column number using name as key in master sheet (mf)
             kc = 0
             On Error Resume Next
             kc = mc.Find(key, LookIn:=xlValues, LookAt:=xlWhole).Column
             '
             ' If kc is > 0 it has found a corresponding column in master file will copy and paste
             ' if kr = 0 then it means that column in data file is new and the macro will (v3) paste
             ' at the far right end of the master file
             ' (When a value is not found an error 91 is thrown that is why on error is used)
             '
             ' If in the data file (cf) there are two columns with the same column heading
             ' the second occurrance will paste over the first so you will see only the second
             '
             ' Calcs range origin and destination
             y1 = 2         ' v3: Do not include Second row (changed 1 for a 2)
             x1 = i - 1
             y2 = lrcf - 1
             y4 = lr - 1
             x4 = kc - 1
             ' Copy range
             Range(Range("A1").Offset(y1, x1), Range("A1").Offset(y2, x1)).Copy
             ' Activate master sheet and Paste range to cell
             Windows(mf).Activate
             If kc > 0 Then
                 ' Column exists in master file
                 Range("A1").Offset(y4, x4).PasteSpecial _
                     Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
             Else
                 ' Column does not exists in master file paste at the far end right
                 ' Paste column heading
                 Range("A1").Offset(0, lc).FormulaR1C1 = key
                 Range("A1").Offset(y4, lc).PasteSpecial _
                     Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                 ' Updates lc for new coloumn
                 lc = lc + 1
             End If
             Windows(cf).Activate
             ' Process next column in data file (cf)
            End If
        Next i
    End If
    ' it activates screen updates
    Application.ScreenUpdating = True
End Sub

THIS WORKED A TREAT!!! I encourage anyone with some understanding of vba to tailor this to their own data sets; you will save god knows how much time but auto-mating the merging this function....
if columns are in the wrong order, it will put it in the right place in the master and new columns will be placed to the far right of your spreadsheet.

Thanks Sergio - you are a legend!