Concatenating two spreadsheets by a column

[Georgi]

Hi,

Here is what I'm trying to do :

Hi,
I need to find a way to concatenate two different spreadsheets by a
column - I have two spreadsheets with slightly different information,
but with a column that can be used as a key. What I need is to find a
way to collate the information in the two columns, and if a
coincidence is found to transfer some of the cells from the same line
as where the coincidence is found from the first spreadsheet into the
other.
Example :
spreadsheet 1 :
ABV 111
BBB 222
VVV 333
GGG 333
DDD 444
ZZZ 567
OOO 452
Spreadsheet 2 :
AAA 432
DDD 324
BBB 342
VVV 432
OOO 642
ZZZ 7878
The first column is the key, so spreadsheet 3 should be :
BBB 222 342
VVV 333 432
OOO 642 452
ZZZ 567 7878

I came up to this VBA, but I need to change some details in it, but
cannot understand it very well ( since I am a rookie ), hence don't
know exactly what to do :

Private Sub cmdUpdate_Click()
Dim sheet1WS As Worksheet, sheet2WS As Worksheet, tableCombWS As
Worksheet
Dim table1lastRow1 As Integer, table1lastRow2 As Integer
Dim rngtable1data1 As Range, rngtable1data2 As Range, rngtable2data
As
Range
Dim c1 As Range, c2 As Range
Dim currRow As Integer, table1currRow1 As Integer, table1currRow2 As
Integer
Set table1WS = Worksheets("table1")
table1lastRow1 = table1WS.Range("E65536").End(xlUp).Row
table1lastRow2 = table1WS.Range("R65536").End(xlUp).Row
Set rngtable1data1 = table1WS.Range("$E$2:$E$" & table1lastRow1 &
"")
Set rngtable1data2 = table1WS.Range("$R$2:$R$" & table1lastRow2 &
"")
Set table2WS = Worksheets("table2")
'table2lastRow = table2WS.Range("D65536").End(xlUp).Row
'Set rngtable2data = table2WS.Range("$E$2:$E$" & table2lastRow & "")
currRow = 2
For Each c1 In rngtable1data1.Cells
For Each c2 In rngtable1data2.Cells
If c1.Text = c2.Text Then
table1currRow1 = c1.Row
table1currRow2 = c2.Row
table2WS.Range("A" & currRow) = c1.Offset(0, -4)
table2WS.Range("B" & currRow) = c1.Offset(0, -3)
table2WS.Range("C" & currRow) = c1.Offset(0, -2)
table2WS.Range("D" & currRow) = c1.Offset(0, -1)
table2WS.Range("E" & currRow) = c1
table2WS.Range("F" & currRow) = c1.Offset(0, 1)
table2WS.Range("G" & currRow) = c1.Offset(0, 2)
table2WS.Range("H" & currRow) = c1.Offset(0, 3)
table2WS.Range("I" & currRow) = c1.Offset(0, 4)
table2WS.Range("J" & currRow) = c1.Offset(0, 5)
table2WS.Range("K" & currRow) = c1.Offset(0, 6)
table2WS.Range("L" & currRow) = c1.Offset(0, 7)
table2WS.Range("M" & currRow) = c1.Offset(0, 8)
table2WS.Range("N" & currRow) = c1.Offset(0, 9)
table2WS.Range("O" & currRow) = c2.Offset(0, 4)
table2WS.Range("P" & currRow) = c2.Offset(0, 5)
table2WS.Range("Q" & currRow) = c2.Offset(0, 6)
table2WS.Range("R" & currRow) = c2.Offset(0, 7)
table2WS.Range("S" & currRow) = c2.Offset(0, 8)
table2WS.Range("T" & currRow) = c2.Offset(0, 9)
table2WS.Range("U" & currRow) = c2.Offset(0, 10)
table2WS.Range("V" & currRow) = c2.Offset(0, 11)
table2WS.Range("W" & currRow) = c2.Offset(0, 12)
table2WS.Range("X" & currRow) = c2.Offset(0, 13)
table2WS.Range("Y" & currRow) = c2.Offset(0, 14)
table2WS.Range("Z" & currRow) = c2.Offset(0, 15)
currRow = currRow + 1
Exit For
End If
Next c2
Next c1
End Sub

This one presumes that the info is in two sheets in one document, and
it makes a new sheet with the new data. As you can see from the code
it uses column E in the first sheet and column R from the second as a
key, and creates a new table with columns A-N from first sheet plus
the relative V-AG columns from second sheet.
Can you please help me find a way to make it work with two sheets
where C is key in the first one and B in the second, and what I need
to do is create a new table with the whole second sheet ( A-T from
second sheet ), plus the
relative information from A cell in sheet1 ?

Thank you very much !

 

[joel]

Create a new sheet called Summary and run this code. I'm using columns
E and R from the two source sheets.

Private Sub cmdUpdate_Click()

Dim c1 As Range
Dim RowCount As Long
Dim NewRow As Long
Dim LastCol As Long
Dim NewCol As Long


Set Sumsht = Sheets("Summary")
NewRow = 2
For Each sht In Sheets
If sht.Name <> Sumsht.Name Then
With sht
RowCount = 2
Do While .Range("E" & RowCount) <> ""
Index = .Range("E" & RowCount)
Data = .Range("R" & RowCount)

With Sumsht
'search if Index already exists
Set c = .Columns("A").Find(what:=Index, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
'add data to column B
..Range("A" & NewRow) = Index
..Range("B" & NewRow) = Data
NewRow = NewRow + 1
Else
'find last column used
LastCol = .Cells(c.Row,
Columns.Count).End(xlToLeft).Column
NewCol = LastCol + 1
..Cells(c.Row, LastCol) = Data
End If
RowCount = RowCount + 1
End With
Loop
End With
End If

Next sht
End Sub

 

[Georgi]

Create a new sheet called Summary and run this code.  I'm using columns
E and R from the two source sheets.

Private Sub cmdUpdate_Click()

Dim c1 As Range
Dim RowCount As Long
Dim NewRow As Long
Dim LastCol As Long
Dim NewCol As Long

Set Sumsht = Sheets("Summary")
NewRow = 2
For Each sht In Sheets
If sht.Name <> Sumsht.Name Then
With sht
RowCount = 2
Do While .Range("E" & RowCount) <> ""
Index = .Range("E" & RowCount)
Data = .Range("R" & RowCount)

With Sumsht
'search if Index already exists
Set c = .Columns("A").Find(what:=Index, _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
'add data to column B
.Range("A" & NewRow) = Index
.Range("B" & NewRow) = Data
NewRow = NewRow + 1
Else
'find last column used
LastCol = .Cells(c.Row,
Columns.Count).End(xlToLeft).Column
NewCol = LastCol + 1
.Cells(c.Row, LastCol) = Data
End If
RowCount = RowCount + 1
End With
Loop
End With
End If

Next sht
End Sub

Hi joel ! Thanks for your input.

Unfortunately when I try to run this code I get a message :

Compile error
Can't assign to read only property