Combining Columns Macro - Help needed to make more efficient/flexible

[thebawp]

Okay, I have spent some time creating a macro that I am hoping to use for various different reports. Because these reports frequently change column order and even column name changes I am interested in making it as flexible as possible. Currently the macro I have written works to combine up to 10 different columns from 2 different sheets. I would prefer to be able to specify the amount of columns to be combined via user input (i.e. in some cases I only need to combine 4 columns, in others 12!). However, I can;t quite get my head around how this could be done. I'm certain it must be something to do with using an array and then a loop but I'm at a loss how to proceed. As you can see from the macro the process is currently:

User defines sheet 1 and sheet 2 to combine.

The macro picks up the row headers from each sheet and adds them to a reference sheet.

From the reference sheet the user defines columns from sheet 1 to add to combined sheet.

Defined Columns from sheet1 are added to the combined sheet.

From reference sheet User defines columns from sheet 2 to add to new sheet, below the data added previously.

Defined Columns are added beneath previously added data on the combined sheet.

It's not very efficient and I'm sure some of it could be done through loops. I've got this far, but I'm afraid I've reached my vba limit at this point! Any help, advice would be very much appreciated!

Sub CombineMacro1()
Application.ScreenUpdating = False
'This part of the macro sets the variables for the first part of the macro (taking data from first sheet and adding to combined sheet.)
Dim A As Range
Dim Sheet1 As String
Dim Sheet2 As String
Dim ColumnNo As Byte
Dim Column As String
Dim Column2 As String
Dim Column3 As String
Dim Column4 As String
Dim Column5 As String
Dim Column6 As String
Dim Column7 As String
Dim Column8 As String
Dim Column9 As String
Dim Column10 As String

'This part of the macro identifies columns from a specified sheet to move via user input.
NameWorksheets:
Sheet1 = InputBox("Enter name of 1st worksheet to combine")
Sheet2 = InputBox("Enter name of 2nd worksheet to combine")
'This part of the macro adds 2 extra worksheets, combined and combined reference.
ActiveWorkbook.Sheets.Add after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count).Name = "Combined"
ActiveWorkbook.Sheets.Add after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count).Name = "Combined Reference"
'This part of the macro populates combined reference sheet with headers from sheet1 and sheet2.
Sheets(Sheet1).Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets("Combined Reference").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Rows("1:1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.RowHeight = 12.75
    Range("A1").Select
    Sheets(Sheet2).Select
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Combined Reference").Select
    Range("C1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A1").Select
    Columns.AutoFit
    
    'This part of the macro asks the user to input the columns they wish to combine.
Application.ScreenUpdating = True
Sheets("Combined Reference").Select
Column1 = Application.InputBox _
            (Prompt:="Enter name of 1st column to add to Combine Sheet from " & Sheet1 & ".", Type:=2)
Column2 = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & ". You have currently added " & Column1 & ".", Type:=2)
            
Column3 = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & _
            ". You have currently added " & Column1 & "," & Column2 & ".", Type:=2)
            
Column4 = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & _
            ". You have currently added " & Column1 & "," & Column2 & "," & Column3 & ".", Type:=2)
            
            
Column5 = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & _
            ". You have currently added " & Column1 & "," & Column2 & "," & Column3 & "," & Column4 & ".", Type:=2)
            
Column6 = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & _
            ". You have currently added " & Column1 & "," & Column2 & "," & Column3 & "," & Column4 & "," & Column5 & ".", Type:=2)
            
Column7 = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & _
            ". You have currently added " & Column1 & "," & Column2 & "," & Column3 & "," & Column4 & "," & Column5 & _
        "," & Column6 & ".", Type:=2)
            
Column8 = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & _
            ". You have currently added " & Column1 & "," & Column2 & "," & Column3 & "," & Column4 & "," & Column5 & _
    "," & Column6 & "," & Column7 & ".", Type:=2)
            
Column9 = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & _
            ". You have currently added " & Column1 & "," & Column2 & "," & Column3 & "," & Column4 & "," & Column5 & _
        "," & Column6 & "," & Column7 & "," & Column8 & ".", Type:=2)
            
Column10 = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & _
            ". You have currently added " & Column1 & "," & Column2 & "," & Column3 & "," & Column4 & "," & Column5 & _
            "," & Column6 & "," & Column7 & "," & Column8 & "," & Column9 & ".", Type:=2)
            
Application.ScreenUpdating = False
            
'This part of the macro looks for specified columns in specified sheets and moves to combined sheet if found.
    Sheets(Sheet1).Select
    Set A = Rows(1).Find(What:=Column1, LookIn:=xlValues, lookat:=xlPart)
    If Column1 = "" Then            'If the user has entered no value into the input box then this part is skipped.
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    
    ElseIf A = Column1 Then
    A.EntireColumn.Copy             'Because this is the first sheet to be combined we can just copy the entire column from the sheet.
    Sheets("Combined").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets(Sheet1).Select
    Cells(1).Select
    ElseIf A = "" Then
    End If
    
    Set A = Rows(1).Find(What:=Column2, LookIn:=xlValues, lookat:=xlPart)
    If Column2 = "" Then
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column2 Then
    A.EntireColumn.Copy
    Sheets("Combined").Select
    Range("B1").Select
    ActiveSheet.Paste
    Sheets(Sheet1).Select
    Cells(1).Select
    ElseIf A = "" Then
    End If
 
    Set A = Rows(1).Find(What:=Column3, LookIn:=xlValues, lookat:=xlPart)
    If Column3 = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column3 Then
    A.EntireColumn.Copy
    Sheets("Combined").Select
    Range("C1").Select
    ActiveSheet.Paste
    Sheets(Sheet1).Select
    Cells(1).Select
    ElseIf A = "" Then
    
    End If
 
    Set A = Rows(1).Find(What:=Column4, LookIn:=xlValues, lookat:=xlPart)
    If Column4 = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column4 Then
    A.EntireColumn.Copy
    Sheets("Combined").Select
    Range("D1").Select
    ActiveSheet.Paste
    Sheets(Sheet1).Select
    Cells(1).Select
    ElseIf A = "" Then
    End If
 
  
    Set A = Rows(1).Find(What:=Column5, LookIn:=xlValues, lookat:=xlPart)
    If Column5 = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    
    ElseIf A = Column5 Then
    A.EntireColumn.Copy
    Sheets("Combined").Select
    Range("E1").Select
    ActiveSheet.Paste
    Sheets(Sheet1).Select
    Cells(1).Select
    ElseIf A = "" Then
    End If
    Set A = Rows(1).Find(What:=Column6, LookIn:=xlValues, lookat:=xlPart)
    If Column6 = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column6 Then
    A.EntireColumn.Copy
    Sheets("Combined").Select
    Range("F1").Select
    ActiveSheet.Paste
    Sheets(Sheet1).Select
    Cells(1).Select
    ElseIf A = "" Then
    
    End If
    Set A = Rows(1).Find(What:=Column7, LookIn:=xlValues, lookat:=xlPart)
    If Column7 = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column7 Then
    A.EntireColumn.Copy
    Sheets("Combined").Select
    Range("G1").Select
    ActiveSheet.Paste
    Sheets(Sheet1).Select
    Cells(1).Select
    ElseIf A = "" Then
    End If
    Set A = Rows(1).Find(What:=Column8, LookIn:=xlValues, lookat:=xlPart)
    If Column8 = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column8 Then
    A.EntireColumn.Copy
    Sheets("Combined").Select
    Range("H1").Select
    ActiveSheet.Paste
    Sheets(Sheet1).Select
    Cells(1).Select
    ElseIf A = "" Then
    
    End If
    Set A = Rows(1).Find(What:=Column9, LookIn:=xlValues, lookat:=xlPart)
    If Column9 = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column9 Then
    A.EntireColumn.Copy
    Sheets("Combined").Select
    Range("I1").Select
    ActiveSheet.Paste
    Sheets(Sheet1).Select
    Cells(1).Select
    ElseIf A = "" Then
    End If
    Set A = Rows(1).Find(What:=Column10, LookIn:=xlValues, lookat:=xlPart)
    If Column10 = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column10 Then
    A.EntireColumn.Copy
    Sheets("Combined").Select
    Range("J1").Select
    ActiveSheet.Paste
    Sheets(Sheet1).Select
    Cells(1).Select
    ElseIf A = "" Then
    End If
    
    Application.ScreenUpdating = True
Sheets("Combined").Select
Cells(1).Select
MsgBox "Columns from " & Sheet1 & " have been added to the Combined Sheet."
'This part of the macro sets variables for the second sheet to be combined.

Dim Column1a As String
Dim Column2a As String
Dim Column3a As String
Dim Column4a As String
Dim Column5a As String
Dim Column6a As String
Dim Column7a As String
Dim Column8a As String
Dim Column9a As String
Dim Column10a As String
Sheets("Combined Reference").Select
Column1a = Application.InputBox _
            (Prompt:="Enter name of 1st column to add to Combine Sheet from " & Sheet1 & ". Column on combined sheet is " & Column1, Type:=2)
Column2a = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & ". Column on combined sheet is " & Column2, Type:=2)
            
Column3a = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & ". Column on combined sheet is " & Column3, Type:=2)
            
Column4a = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & ". Column on combined sheet is " & Column4, Type:=2)
            
Column5a = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & ". Column on combined sheet is " & Column5, Type:=2)
            
Column6a = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & ". Column on combined sheet is " & Column6, Type:=2)
            
Column7a = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & ". Column on combined sheet is " & Column7, Type:=2)
            
Column8a = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & ". Column on combined sheet is " & Column8, Type:=2)
            
Column9a = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & ". Column on combined sheet is " & Column9, Type:=2)
            
Column10a = Application.InputBox _
            (Prompt:="Enter name of next column to Combine Sheet from  " & Sheet1 & ". Column on combined sheet is " & Column10, Type:=2)

'This part of the macro looks for specified columns in specified sheets and moves to combined sheet if found.
Sheets("Combined").Select
    Dim LastRow As Long
    With Worksheets("Combined")
    
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Sheets(Sheet2).Select
    Set A = Rows(1).Find(What:=Column1a, LookIn:=xlValues, lookat:=xlPart)
    If Column1a = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column1a Then
    A.EntireColumn.Select                   'Because we can't paste the entire column into the combined sheet (as it now has data in) we need to select only the range of data.
    ActiveCell.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Range(ActiveCell.Address & ":" & Left(ActiveCell.Address, 2) & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("Combined").Select
    Range("A2").Select
    Range("A" & LastRow).Offset(1, 0).Select    'This also tells the macro to find the first blank cell in the column and paste the data into it (so as not to overwrite previously added data).
    ActiveSheet.Paste
    Sheets(Sheet2).Select
    Cells(1).Select
End If

    Set A = Rows(1).Find(What:=Column2a, LookIn:=xlValues, lookat:=xlPart)
    If Column2a = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column2a Then
    A.EntireColumn.Select
    ActiveCell.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Range(ActiveCell.Address & ":" & Left(ActiveCell.Address, 2) & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("Combined").Select
    Range("B2").Select
    Range("B" & LastRow).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets(Sheet2).Select
    Cells(1).Select
End If
    Set A = Rows(1).Find(What:=Column3a, LookIn:=xlValues, lookat:=xlPart)
    If Column3a = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column3a Then
    A.EntireColumn.Select
    ActiveCell.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Range(ActiveCell.Address & ":" & Left(ActiveCell.Address, 2) & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("Combined").Select
    Range("C2").Select
    Range("C" & LastRow).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets(Sheet2).Select
    Cells(1).Select
End If
    Set A = Rows(1).Find(What:=Column4a, LookIn:=xlValues, lookat:=xlPart)
    If Column4a = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column4a Then
    A.EntireColumn.Select
    ActiveCell.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Range(ActiveCell.Address & ":" & Left(ActiveCell.Address, 2) & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("Combined").Select
    Range("D2").Select
    Range("D" & LastRow).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets(Sheet2).Select
    Cells(1).Select
End If
    Set A = Rows(1).Find(What:=Column5a, LookIn:=xlValues, lookat:=xlPart)
    If Column5a = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column5a Then
    A.EntireColumn.Select
    ActiveCell.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Range(ActiveCell.Address & ":" & Left(ActiveCell.Address, 2) & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("Combined").Select
    Range("E2").Select
    Range("E" & LastRow).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets(Sheet2).Select
    Cells(1).Select
End If
    Set A = Rows(1).Find(What:=Column6a, LookIn:=xlValues, lookat:=xlPart)
    If Column6a = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    
    ElseIf A = Column6a Then
    A.EntireColumn.Select
    ActiveCell.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Range(ActiveCell.Address & ":" & Left(ActiveCell.Address, 2) & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("Combined").Select
    Range("F2").Select
    Range("F" & LastRow).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets(Sheet2).Select
    Cells(1).Select
End If
    Set A = Rows(1).Find(What:=Column7a, LookIn:=xlValues, lookat:=xlPart)
    If Column7a = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    ElseIf A = Column7a Then
    A.EntireColumn.Select
    ActiveCell.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Range(ActiveCell.Address & ":" & Left(ActiveCell.Address, 2) & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("Combined").Select
    Range("G2").Select
    Range("G" & LastRow).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets(Sheet2).Select
    Cells(1).Select
End If
    Set A = Rows(1).Find(What:=Column8a, LookIn:=xlValues, lookat:=xlPart)
    If Column8a = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    
    ElseIf A = Column8a Then
    A.EntireColumn.Select
    ActiveCell.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Range(ActiveCell.Address & ":" & Left(ActiveCell.Address, 2) & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("Combined").Select
    Range("H2").Select
    Range("H" & LastRow).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets(Sheet2).Select
    Cells(1).Select
End If
    Set A = Rows(1).Find(What:=Column9a, LookIn:=xlValues, lookat:=xlPart)
    If Column9a = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
   
    ElseIf A = Column9a Then
    A.EntireColumn.Select
    ActiveCell.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Range(ActiveCell.Address & ":" & Left(ActiveCell.Address, 2) & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("Combined").Select
    Range("I2").Select
    Range("I" & LastRow).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets(Sheet2).Select
    Cells(1).Select
End If
    Set A = Rows(1).Find(What:=Column10a, LookIn:=xlValues, lookat:=xlPart)
    If Column10a = "" Then
    
    ElseIf A Is Nothing Then
    MsgBox "No column by that name"
    
    ElseIf A = Column10a Then
    A.EntireColumn.Select
    ActiveCell.End(xlUp).Select
    Selection.Offset(1, 0).Select
    Range(ActiveCell.Address & ":" & Left(ActiveCell.Address, 2) & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("Combined").Select
    Range("J2").Select
    Range("J" & LastRow).Offset(1, 0).Select
    ActiveSheet.Paste
    Sheets(Sheet2).Select
    Cells(1).Select
    
End If

End With
'This part of the macro sets all activecells within the sheets to A1 and also formats the combined sheet.
Sheets(Sheet1).Select
Cells(1).Select
Sheets(Sheet2).Select
Cells(1).Select
Sheets("Combined").Select
Columns.AutoFit
 Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("A1").Select
    
        Application.ScreenUpdating = True
    
    MsgBox "Data from " & Sheet1 & " and " & Sheet2 & " has been combined."
    
End Sub

 

[wolverineb]

Your code is in serious need of refactoring.

Honestly, though, while I can pretty quickly explain to use one looping bit of code with the number of loops determined by asking the user first, I'm not sure what your macro is really doing. It might be better to do something entirely different. Can you explain what "combine" means in this context, or show an example of the sheets before and after the code runs?

Also, it would be a good idea to at least put "Option Explicit" at the top of your module. You declare a variable "Column" when you meant to say "Column1." This would have been caught by the compiler if you put the option-explicit declaration in there to require all variables to be declared explicitly.

Shoot me some more details and I can better answer your question.

 

[thebawp]

wolverineb, thanks for your reply. I'm aware it's messy, perhaps the consequences of no training in VBA (I'm sure that's very apparent!). The column as variable and columnno aren't used at all, (yes, I should have option explicit in there but it's a work in progress at the moment!) I must have accidentally left them in when I posted as I was in the middle of trying to replace the multiple variables with something a bit simpler and more efficient (at which I've failed).

Let me try and explain what it does anyway.

I have two worksheets. Worksheet one has say a number of columns, 5 of which contain client data (i.e. age, client type, date of service start, team client assigned to, source of data). There is then a second sheet, which has a different amount of columns but it shares the five columns listed above. However, the data is from a different data source and contains different client details. These worksheets change from month to month, often columns are in different positions, have different titles etc so it's very important for me to maintain the ability of allowing the user just to select the headers of the columns for the macro.

By combine I mean - worksheet 1 contains 20 (in reality this would be in the thousands) different clients, worksheet 2 contains 35 different clients. The macro would combine all of the client details from worksheet 1 and worksheet2 so the combined sheet would have the details of 55 clients.

My macro will allow me to select the titles of the five (for arguments sake, it can pick up to ten) columns on the first sheet, look for them on the first sheet, and copy each of the five columns onto a new sheet called combined.

Then the macro asks me which data I want to combine with the columns on the combined sheet from sheet 2, which I again would select. It takes the data on sheet 2 and pastes it onto the bottom of each corresponding column.

In some cases, there might be data on sheet 1 which won't be on sheet 2 but I want to copy it across anyway (this would leave a blank column.)

I've put together a quick test sheet to try and show what it does - just run the macro and it should guide you through the process and you should get a better idea of what it does. Just try adding reference, name, age, source, client type and start date from both sheets (press return when you don't want to add any more columns for the first set and second set).

https://docs.google.com/fileview?id...MjY4Ni00NTMwLWE0MTMtYTE3Mzk5YmFiNTkw&hl=en_GB

Thanks so much for looking at this, it's very much appreciated!

 

[wolverineb]

Try this. It's broken into two macros. Run the CreateInteractiveSheet one first, then the other one (CreateCombinedDataSheet) after you change the settings on the first sheet that gets created. I think I inadvertently left some code snippets in Module2. You can ignore those.

I rewrote most of what you had. Take a look at the code to see how it works. I think this is more flexible.

https://docs.google.com/fileview?id...zgtNDYzYi00NjZlLWFhMDEtOTQzZTY0NTNkMzMz&hl=en

 

[thebawp]

Thank you! What can I say, other than that's stunning in its implementation and after a tweak or two is working exactly as I would have wanted it to! Although initially I struggled to understand the second macro, after a bit of investigation I think I understand how it works.

There was one error in the code for the second part of the macro that meant it was copying from worksheeta twice

You had:

Set rngColumnA = wksSheetA.Rows(1).Find(wksRef.Cells(lCounter, 4).Value, LookIn:=xlValues)
Set rngColumnB = wksSheetA.Rows(1).Find(wksRef.Cells(lCounter, 5).Value, LookIn:=xlValues)

which I changed to:

Set rngColumnA = wksSheetA.Rows(1).Find(wksRef.Cells(lCounter, 4).Value, LookIn:=xlValues)
Set rngColumnB = wksSheetB.Rows(1).Find(wksRef.Cells(lCounter, 5).Value, LookIn:=xlValues)

As mentioned, I've tweaked it slightly so that it will return all data in a column even if there are some blanks in the columns (happens frequently with the data I work with), and it seems to be working wonderfully!

I've uploaded my tweaked version in case others would find it of use. Thank you again, you have no idea how much time this could end up saving me!

http://spreadsheets.google.com/ccc?key=0AjyPb6WfMcjMdGhDREx4TUZTRjJGLWM1d2ktUS1UWXc&hl=en_GB

 

[wolverineb]

Good catch. I was a little sleepy when I wrote it.

I was a little worried about the "blanks in columns" problem, but I figured I'd get you something to work with. I'm glad you were able to adjust it to compensate.

 

[thebawp]

Haha, well you did all the hard work! I just recycled some of the code from my attempt (so of course there's probably a better way of doing it, I'm just stoked to get it working!). Thanks again, your work is very much appreciated (and dare I say, worshipped?!)

 

[wolverineb]

Just realized that my error handling is missing a line. I normally use a more complicated version and when I changed it for this, I deleted one too many lines. If you enter this just after the MsgBox and before End Sub on both procedures, it will be more correct:

Resume ErrorExit

It actually doesn't matter for this particular application, but it matters a lot if you have a procedure that does any sort of housekeeping or cleanup before it ends.

Okay. Time for dinner with the kids ...