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!
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!
Code:
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