I have a rather large database with two sheets of data. I want to take sheet
two and put the data in column C to sheet one column C where A and B match on
both sheets.

Sheet One
A B C
1 100 4
2 200 1
3 200 2
4 200 5


Sheet Two
A B C
1 100 4 CAR12
2 100 4 WIL13
3 100 4 CAR14
4 200 1 CAR15
5 200 1 CAR16
6 200 2 CAR17
7 200 5 WIL18

What the result should look like
A B C
1 100 4 CAR12; WIL13; CAR14
2 200 1 CAR15; CAR16
3 200 2 CAR17
4 200 5 WIL18

Change the "Set Sht" lines to match the names in your worksheet.

Sub CombineSheets()

Set Sht1 = Sheets("Sheet1")
Set Sht2 = Sheets("Sheet2")
With Sht1
Sh1RowCount = 1
Do While .Range("A" & Sh1RowCount) < ""
Sh2RowCount = 1
Data = ""
With Sht2
Do While .Range("A" & Sh2RowCount) < ""
If Sht1.Range("A" & Sh1RowCount) = _
.Range("A" & Sh2RowCount) And _
Sht1.Range("B" & Sh1RowCount) = _
.Range("B" & Sh2RowCount) Then

If Data = "" Then
Data = .Range("C" & Sh2RowCount)
Else
Data = Data & "; " & .Range("C" & Sh2RowCount)
End If
End If
Sht1.Range("C" & Sh1RowCount) = Data
Sh2RowCount = Sh2RowCount + 1
Loop
End With
Sht1.Range("C" & Sh1RowCount) = Data
Sh1RowCount = Sh1RowCount + 1
Loop
End With

End Sub


"Jeremy" wrote:

I have a rather large database with two sheets of data. I want to take sheet
two and put the data in column C to sheet one column C where A and B match on
both sheets.

Sheet One
A B C
1 100 4
2 200 1
3 200 2
4 200 5


Sheet Two
A B C
1 100 4 CAR12
2 100 4 WIL13
3 100 4 CAR14
4 200 1 CAR15
5 200 1 CAR16
6 200 2 CAR17
7 200 5 WIL18

What the result should look like
A B C
1 100 4 CAR12; WIL13; CAR14
2 200 1 CAR15; CAR16
3 200 2 CAR17
4 200 5 WIL18

Hi Jeremy

The following code will do what you want

Sub Consolidate()

Dim i As Long, lr As Long
Dim wss As Worksheet, wsd As Worksheet
Dim rng1 As Range, rng2 As Range
Application.ScreenUpdating = False
Set wss = ThisWorkbook.Sheets("Sheet1") ' Source
Set wsd = ThisWorkbook.Sheets("Sheet2") 'Destination
lr = wsd.Cells(Rows.Count, "A").End(xlUp).Row
If wss.AutoFilterMode = False Then
If wss.Range("A1") < "" Then
wss.Rows("1:1").Insert Shift:=xlDown
End If
wss.Range("A1:B1").AutoFilter
End If
For i = 1 To lr
Selection.AutoFilter Field:=1, Criteria1:=wsd.Cells(i, 1).Value
Selection.AutoFilter Field:=2, Criteria1:=wsd.Cells(i, 2).Value
Set rng1 = wss.AutoFilter.Range.Columns(3).Cells
Set rng1 = rng1.Offset(1, 0).Resize(rng1.Rows.Count - 1, 1)
Set rng2 = rng1.SpecialCells(xlVisible)
rng2.Copy
wsd.Cells(i, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Next i
Application.ScreenUpdating = True
End Sub

Copy the Code above
Alt+F11 to invoke the VB Editor
InsertModule
Paste code into white pane that appears
Alt+F11 to return to Excel

To use
Select sheet containing the PT's
Alt+F8 to bring up Macros
Highlight the macro name
Run


--
Regards
Roger Govier

"Jeremy" wrote in message
...
I have a rather large database with two sheets of data. I want to take
sheet
two and put the data in column C to sheet one column C where A and B match
on
both sheets.

Sheet One
A B C
1 100 4
2 200 1
3 200 2
4 200 5


Sheet Two
A B C
1 100 4 CAR12
2 100 4 WIL13
3 100 4 CAR14
4 200 1 CAR15
5 200 1 CAR16
6 200 2 CAR17
7 200 5 WIL18

What the result should look like
A B C
1 100 4 CAR12; WIL13; CAR14
2 200 1 CAR15; CAR16
3 200 2 CAR17
4 200 5 WIL18

Download and install the free add-in Morefunc.xll from:

http://xcell05.free.fr/morefunc/english/index.htm
then use this formula

=SUBSTITUTE(TRIM(MCONCAT(IF((Sheet2!$A$1:$A$7=A1)* (Sheet2!$B$1:$B$7=B1),Sheet2!$C$1:$C$7,"")&" "))," ","; ")

ctrl+shift+enter, not just enter
copy down


"Jeremy" wrote:

I have a rather large database with two sheets of data. I want to take sheet
two and put the data in column C to sheet one column C where A and B match on
both sheets.

Sheet One
A B C
1 100 4
2 200 1
3 200 2
4 200 5


Sheet Two
A B C
1 100 4 CAR12
2 100 4 WIL13
3 100 4 CAR14
4 200 1 CAR15
5 200 1 CAR16
6 200 2 CAR17
7 200 5 WIL18

What the result should look like
A B C
1 100 4 CAR12; WIL13; CAR14
2 200 1 CAR15; CAR16
3 200 2 CAR17
4 200 5 WIL18

What do you mean by ctrl+shift+enter?


"Teethless mama" wrote:

Download and install the free add-in Morefunc.xll from:

http://xcell05.free.fr/morefunc/english/index.htm
then use this formula

=SUBSTITUTE(TRIM(MCONCAT(IF((Sheet2!$A$1:$A$7=A1)* (Sheet2!$B$1:$B$7=B1),Sheet2!$C$1:$C$7,"")&" "))," ","; ")

ctrl+shift+enter, not just enter
copy down


"Jeremy" wrote:

I have a rather large database with two sheets of data. I want to take sheet
two and put the data in column C to sheet one column C where A and B match on
both sheets.

Sheet One
A B C
1 100 4
2 200 1
3 200 2
4 200 5


Sheet Two
A B C
1 100 4 CAR12
2 100 4 WIL13
3 100 4 CAR14
4 200 1 CAR15
5 200 1 CAR16
6 200 2 CAR17
7 200 5 WIL18

What the result should look like
A B C
1 100 4 CAR12; WIL13; CAR14
2 200 1 CAR15; CAR16
3 200 2 CAR17
4 200 5 WIL18

You enter the formula by pressing ctrl + shift & enter as opposed to just
pressing enter
Lookup array formulas in help

--


Regards,


Peo Sjoblom



"Jeremy" wrote in message
...
What do you mean by ctrl+shift+enter?


"Teethless mama" wrote:

Download and install the free add-in Morefunc.xll from:

http://xcell05.free.fr/morefunc/english/index.htm
then use this formula

=SUBSTITUTE(TRIM(MCONCAT(IF((Sheet2!$A$1:$A$7=A1)* (Sheet2!$B$1:$B$7=B1),Sheet2!$C$1:$C$7,"")&"
"))," ","; ")

ctrl+shift+enter, not just enter
copy down


"Jeremy" wrote:

I have a rather large database with two sheets of data. I want to take
sheet
two and put the data in column C to sheet one column C where A and B
match on
both sheets.

Sheet One
A B C
1 100 4
2 200 1
3 200 2
4 200 5


Sheet Two
A B C
1 100 4 CAR12
2 100 4 WIL13
3 100 4 CAR14
4 200 1 CAR15
5 200 1 CAR16
6 200 2 CAR17
7 200 5 WIL18

What the result should look like
A B C
1 100 4 CAR12; WIL13; CAR14
2 200 1 CAR15; CAR16
3 200 2 CAR17
4 200 5 WIL18

I was not able to get this to work.

"Roger Govier" wrote:

Hi Jeremy

The following code will do what you want

Sub Consolidate()

Dim i As Long, lr As Long
Dim wss As Worksheet, wsd As Worksheet
Dim rng1 As Range, rng2 As Range
Application.ScreenUpdating = False
Set wss = ThisWorkbook.Sheets("Sheet1") ' Source
Set wsd = ThisWorkbook.Sheets("Sheet2") 'Destination
lr = wsd.Cells(Rows.Count, "A").End(xlUp).Row
If wss.AutoFilterMode = False Then
If wss.Range("A1") < "" Then
wss.Rows("1:1").Insert Shift:=xlDown
End If
wss.Range("A1:B1").AutoFilter
End If
For i = 1 To lr
Selection.AutoFilter Field:=1, Criteria1:=wsd.Cells(i, 1).Value
Selection.AutoFilter Field:=2, Criteria1:=wsd.Cells(i, 2).Value
Set rng1 = wss.AutoFilter.Range.Columns(3).Cells
Set rng1 = rng1.Offset(1, 0).Resize(rng1.Rows.Count - 1, 1)
Set rng2 = rng1.SpecialCells(xlVisible)
rng2.Copy
wsd.Cells(i, 3).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Next i
Application.ScreenUpdating = True
End Sub

Copy the Code above
Alt+F11 to invoke the VB Editor
InsertModule
Paste code into white pane that appears
Alt+F11 to return to Excel

To use
Select sheet containing the PT's
Alt+F8 to bring up Macros
Highlight the macro name
Run


--
Regards
Roger Govier

"Jeremy" wrote in message
...
I have a rather large database with two sheets of data. I want to take
sheet
two and put the data in column C to sheet one column C where A and B match
on
both sheets.

Sheet One
A B C
1 100 4
2 200 1
3 200 2
4 200 5


Sheet Two
A B C
1 100 4 CAR12
2 100 4 WIL13
3 100 4 CAR14
4 200 1 CAR15
5 200 1 CAR16
6 200 2 CAR17
7 200 5 WIL18

What the result should look like
A B C
1 100 4 CAR12; WIL13; CAR14
2 200 1 CAR15; CAR16
3 200 2 CAR17
4 200 5 WIL18

Hi Jeremy

In what way?
Did it crash?
Did it give the wrong result?
It worked perfectly on the set of data you posted.

If you want to send me the workbook, with the code that you added, I will
take a look.
To mail direct, send to
roger at technology4u dot co dot uk
Change the at and dots to make a valid email address.
--
Regards
Roger Govier

"Jeremy" wrote in message
...
I was not able to get this to work.

"Roger Govier" wrote:

Hi Jeremy

The following code will do what you want

Sub Consolidate()

Dim i As Long, lr As Long
Dim wss As Worksheet, wsd As Worksheet
Dim rng1 As Range, rng2 As Range
Application.ScreenUpdating = False
Set wss = ThisWorkbook.Sheets("Sheet1") ' Source
Set wsd = ThisWorkbook.Sheets("Sheet2") 'Destination
lr = wsd.Cells(Rows.Count, "A").End(xlUp).Row
If wss.AutoFilterMode = False Then
If wss.Range("A1") < "" Then
wss.Rows("1:1").Insert Shift:=xlDown
End If
wss.Range("A1:B1").AutoFilter
End If
For i = 1 To lr
Selection.AutoFilter Field:=1, Criteria1:=wsd.Cells(i, 1).Value
Selection.AutoFilter Field:=2, Criteria1:=wsd.Cells(i, 2).Value
Set rng1 = wss.AutoFilter.Range.Columns(3).Cells
Set rng1 = rng1.Offset(1, 0).Resize(rng1.Rows.Count - 1, 1)
Set rng2 = rng1.SpecialCells(xlVisible)
rng2.Copy
wsd.Cells(i, 3).PasteSpecial Paste:=xlPasteValues,
Transpose:=True
Next i
Application.ScreenUpdating = True
End Sub

Copy the Code above
Alt+F11 to invoke the VB Editor
InsertModule
Paste code into white pane that appears
Alt+F11 to return to Excel

To use
Select sheet containing the PT's
Alt+F8 to bring up Macros
Highlight the macro name
Run


--
Regards
Roger Govier

"Jeremy" wrote in message
...
I have a rather large database with two sheets of data. I want to take
sheet
two and put the data in column C to sheet one column C where A and B
match
on
both sheets.

Sheet One
A B C
1 100 4
2 200 1
3 200 2
4 200 5


Sheet Two
A B C
1 100 4 CAR12
2 100 4 WIL13
3 100 4 CAR14
4 200 1 CAR15
5 200 1 CAR16
6 200 2 CAR17
7 200 5 WIL18

What the result should look like
A B C
1 100 4 CAR12; WIL13; CAR14
2 200 1 CAR15; CAR16
3 200 2 CAR17
4 200 5 WIL18

hi Jeremy
Were your sheets called Sheet1 and Sheet2?
If not, change the names where it says Source and Destination to match your
sheet names

--
Regards
Roger Govier

"Jeremy" wrote in message
...
I was not able to get this to work.

"Roger Govier" wrote:

Hi Jeremy

The following code will do what you want

Sub Consolidate()

Dim i As Long, lr As Long
Dim wss As Worksheet, wsd As Worksheet
Dim rng1 As Range, rng2 As Range
Application.ScreenUpdating = False
Set wss = ThisWorkbook.Sheets("Sheet1") ' Source
Set wsd = ThisWorkbook.Sheets("Sheet2") 'Destination
lr = wsd.Cells(Rows.Count, "A").End(xlUp).Row
If wss.AutoFilterMode = False Then
If wss.Range("A1") < "" Then
wss.Rows("1:1").Insert Shift:=xlDown
End If
wss.Range("A1:B1").AutoFilter
End If
For i = 1 To lr
Selection.AutoFilter Field:=1, Criteria1:=wsd.Cells(i, 1).Value
Selection.AutoFilter Field:=2, Criteria1:=wsd.Cells(i, 2).Value
Set rng1 = wss.AutoFilter.Range.Columns(3).Cells
Set rng1 = rng1.Offset(1, 0).Resize(rng1.Rows.Count - 1, 1)
Set rng2 = rng1.SpecialCells(xlVisible)
rng2.Copy
wsd.Cells(i, 3).PasteSpecial Paste:=xlPasteValues,
Transpose:=True
Next i
Application.ScreenUpdating = True
End Sub

Copy the Code above
Alt+F11 to invoke the VB Editor
InsertModule
Paste code into white pane that appears
Alt+F11 to return to Excel

To use
Select sheet containing the PT's
Alt+F8 to bring up Macros
Highlight the macro name
Run


--
Regards
Roger Govier

"Jeremy" wrote in message
...
I have a rather large database with two sheets of data. I want to take
sheet
two and put the data in column C to sheet one column C where A and B
match
on
both sheets.

Sheet One
A B C
1 100 4
2 200 1
3 200 2
4 200 5


Sheet Two
A B C
1 100 4 CAR12
2 100 4 WIL13
3 100 4 CAR14
4 200 1 CAR15
5 200 1 CAR16
6 200 2 CAR17
7 200 5 WIL18

What the result should look like
A B C
1 100 4 CAR12; WIL13; CAR14
2 200 1 CAR15; CAR16
3 200 2 CAR17
4 200 5 WIL18