Reply to thread

Message: [QUOTE="bawpie, post: 6434834"] I've managed to create a macro that will take up to ten columns from one sheet and combine them with up to ten columns from another sheet. It's working as well as I could have hoped, but I'm positive that there are ways to make the macro far more effecient than it currently is. For instance, for each column I have an individual process to handle picking the column from sheet1 and combining it with the column from sheet2 10 times - I'm sure this process could be written to loop 10 times off one bit of code, but I'm uncertain how to do it. Ideally, however, I would like to be able to define how many columns I wish to combine on a sheet - again I have a vague idea that it would involve setting a variable input by the user and then possibly using that variable in a for next loop but I really don't know enough to get this working. The code for the macro is below, I'm not sure if I can attach an example workbook to this post? Hopefully it makes some sense, and any suggestions, ideas or improvements you can suggest will be most 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 Column1 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 [/QUOTE]

Verification