VBA Match & Copy

[hobbiton73]

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-prog...opy-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

[snb]

Please post a sample of your data.

I'd use (because much faster):

Sub M_snb()
   sn=Sheets("All Resources").columns(4).specialcells(2)
   st=Sheets("All Resources").columns(8).specialcells(2)
   sp=sheets("All Data").columns(2).specialcells(2)
   sq=sheets("All Data").columns(5).specialcells(2)

   for j=8 to ubound(sn)
     if not iserror(application.match(sn(j,1),sp,0)) then sq(j,1)=st(j,1)
   next
   
    sheets("All Data").columns(5).specialcells(2)=sq
End Sub

[hobbiton73]

Hi @snb, thank you for taking the time to reply to my post and for putting the alternative solution.

Unfortunately because I'm at work I'm unable to post any data, but I wondered if you could possibly add some comments to your code please, and I think I may be able to put together a solution from there.

Many thanks and kind regards

Chris