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

Trust this is a purpose made macro for self use.
Then I may get rid of all input boxes and directly put the required
parameters in a worksheet itself, like

sheet1,
cells(1,1)=name of first worksheet to combine;
cells(2,1)=name of second worksheet to combine;
and the like

cells(1 to 10, "C")=column strings to copy
cells(1 to 10, "D")=column strings to append to

then set srcrng=range(cells(1,"C"), cells(10,"C")
for each c in srcrng
do the appending
next c

the appending target is simply c.offset(0,1)

"bawpie" wrote in message
...
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

KC, thanks for your response. Effectively, I already have the macro entering
fields on a sheet that I can then select to add to the input boxes (and set
the variables).

Could you explain this part of your comment though:

then set srcrng=range(cells(1,"C"), cells(10,"C")
for each c in srcrng
do the appending
next c

I'm not sure how I would work my current code into doing the appending ie
identify C1, C2, etc?

"KC" wrote:

Trust this is a purpose made macro for self use.
Then I may get rid of all input boxes and directly put the required
parameters in a worksheet itself, like

sheet1,
cells(1,1)=name of first worksheet to combine;
cells(2,1)=name of second worksheet to combine;
and the like

cells(1 to 10, "C")=column strings to copy
cells(1 to 10, "D")=column strings to append to

then set srcrng=range(cells(1,"C"), cells(10,"C")
for each c in srcrng
do the appending
next c

the appending target is simply c.offset(0,1)

"bawpie" wrote in message
...
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

It is just a standard loop.
It starts from cells(1,"C"),
next loop uses cells(2,"C"), cells(3,"C")... till end cells(10,"C"),
their values take the place of column1, column2... as in your code, thus
updating as it loops.

"bawpie" wrote in message
...
KC, thanks for your response. Effectively, I already have the macro
entering
fields on a sheet that I can then select to add to the input boxes (and
set
the variables).

Could you explain this part of your comment though:

then set srcrng=range(cells(1,"C"), cells(10,"C")
for each c in srcrng
do the appending
next c

I'm not sure how I would work my current code into doing the appending ie
identify C1, C2, etc?

"KC" wrote:

Trust this is a purpose made macro for self use.
Then I may get rid of all input boxes and directly put the required
parameters in a worksheet itself, like

sheet1,
cells(1,1)=name of first worksheet to combine;
cells(2,1)=name of second worksheet to combine;
and the like

cells(1 to 10, "C")=column strings to copy
cells(1 to 10, "D")=column strings to append to

then set srcrng=range(cells(1,"C"), cells(10,"C")
for each c in srcrng
do the appending
next c

the appending target is simply c.offset(0,1)

"bawpie" wrote in message
...
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

Well, after posting this problem at Mr Excel, I was pretty much handed a
re-written solution which is now working perfectly. Just in case anyone else
is ever curious as to how this can be done, here is the link:
http://www.mrexcel.com/forum/showthr...=1#post2206514

"bawpie" wrote:

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"