hobbiton73
07-21-2014, 11:25 PM
Hi, I wonder whether someone may be able to help me please.
I'm using the code below to find a match in multiple columns between two sheets and paste the resulting outocome into the 'Destination' sheet.
Sub AllDataSignals3()
Dim Dic As Object
Dim Dn As Range
Dim Rng As Range
'The section of code below looks in column D on the "All Resources" (Source sheet)
With Sheets("All Resources")
'This is the column on the 'Source' sheet you are comparing to the 'Destination' sheet.
Set Rng = .Range(.Range("D8"), .Range("D" & Rows.Count).End(xlUp))
End With
'The section of code below then looks in column G on the 'Source' sheet and stores that value.
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For Each Dn In Rng
Set Dic(Dn & Dn.Offset(, 3)) = Dn
Next
'The section of code below then looks in column E on the "All Data" (Destination sheet)
With Sheets("All Data")
'This the column on the 'Destination' sheet you are comparing to the 'Source' sheet.
Set Rng = .Range(.Range("E8"), .Range("E" & Rows.Count).End(xlUp))
End With
'The first two lines below then searches column M on the 'Destination' sheet and stores that value.
For Each Dn In Rng
If Dic.exists(Dn & Dn.Offset(, 8)) Then
'Where the values stored in the 'Dictionary' variable match, the values from column H are copied and paste into column H on the 'Destination' sheet.
'The first offset is the 'Destination' sheet i.e. 3 columns from column E.
'The middle offset is the value being checked in column M i.e. 8 columns from column E on the Destination' sheet.
'The last offset is the 'Source' sheet i.e. 4 columns from column d.
Dn.Offset(, 3).Value = Dic.Item(Dn & Dn.Offset(, 8)).Offset(, 4).Value
End If
Next Dn
End Sub
The code works fine, but I'd like to adapt this a little and change the following two lines to look at specific cell value rather than the offset on each row:
If Dic.exists(Dn & Dn.Offset(, 8)) Then
Dn.Offset(, 3).Value = Dic.Item(Dn & Dn.Offset(, 8)).Offset(, 4).Value
I've tried the following and although the code runs the values are not being paste into the column:
If Dic exsits((Dn.Range("B3")) then
Dn.Offset(, 3).Value = Dic.Item(Dn.Range("B3")).Offset(, 4).Value
I did make a post herehttp://www.excelforum.com/excel-programming-vba-macros/1025909-vba-match-columns-and-copy-cells.html but I haven't received a reply.
I just wondered whether someone may be able to look at this please and let me know where I'm going wrong.
Many thanks and kind regards
Chris
I'm using the code below to find a match in multiple columns between two sheets and paste the resulting outocome into the 'Destination' sheet.
Sub AllDataSignals3()
Dim Dic As Object
Dim Dn As Range
Dim Rng As Range
'The section of code below looks in column D on the "All Resources" (Source sheet)
With Sheets("All Resources")
'This is the column on the 'Source' sheet you are comparing to the 'Destination' sheet.
Set Rng = .Range(.Range("D8"), .Range("D" & Rows.Count).End(xlUp))
End With
'The section of code below then looks in column G on the 'Source' sheet and stores that value.
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
For Each Dn In Rng
Set Dic(Dn & Dn.Offset(, 3)) = Dn
Next
'The section of code below then looks in column E on the "All Data" (Destination sheet)
With Sheets("All Data")
'This the column on the 'Destination' sheet you are comparing to the 'Source' sheet.
Set Rng = .Range(.Range("E8"), .Range("E" & Rows.Count).End(xlUp))
End With
'The first two lines below then searches column M on the 'Destination' sheet and stores that value.
For Each Dn In Rng
If Dic.exists(Dn & Dn.Offset(, 8)) Then
'Where the values stored in the 'Dictionary' variable match, the values from column H are copied and paste into column H on the 'Destination' sheet.
'The first offset is the 'Destination' sheet i.e. 3 columns from column E.
'The middle offset is the value being checked in column M i.e. 8 columns from column E on the Destination' sheet.
'The last offset is the 'Source' sheet i.e. 4 columns from column d.
Dn.Offset(, 3).Value = Dic.Item(Dn & Dn.Offset(, 8)).Offset(, 4).Value
End If
Next Dn
End Sub
The code works fine, but I'd like to adapt this a little and change the following two lines to look at specific cell value rather than the offset on each row:
If Dic.exists(Dn & Dn.Offset(, 8)) Then
Dn.Offset(, 3).Value = Dic.Item(Dn & Dn.Offset(, 8)).Offset(, 4).Value
I've tried the following and although the code runs the values are not being paste into the column:
If Dic exsits((Dn.Range("B3")) then
Dn.Offset(, 3).Value = Dic.Item(Dn.Range("B3")).Offset(, 4).Value
I did make a post herehttp://www.excelforum.com/excel-programming-vba-macros/1025909-vba-match-columns-and-copy-cells.html but I haven't received a reply.
I just wondered whether someone may be able to look at this please and let me know where I'm going wrong.
Many thanks and kind regards
Chris