Copy Range of Cells with Scripting Dictionary

[reberryjr]

I have 2 worksheets within the same workbook. I'm trying to copy a range of cells from mFS and paste them into mWD where a key exists on both sheets. I didn't want to add 24 VLOOKUP formulas with VBA, so I thought I would try my hand at a scripting dictionary (which may not be the best route either). Here is the code that I have now, which works, but I'm unsure how to copy the range of cells over instead of just 1 cell at a time. Thoughts?

Sub MergeData()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim m As Workbook
Dim mWD, mFS As Worksheet
Dim WDLR, FSLR As Long

Dim C1 As Range
Dim Dic As Object

Set m = ThisWorkbook
Set mWD = m.Sheets("Working_Data")
Set mFS = m.Sheets("From_SPARC")

WDLR = mWD.Range("A" & Rows.Count).End(xlUp).Row

FSLR = mFS.Range("B" & Rows.Count).End(xlUp).Row

mFS.Range("A2:A" & FSLR).Formula = "=RC[1] & "" | "" & RC[3] & "" | "" & RC[4] & "" | "" & RC[5]"

mWD.Range("M2:M" & WDLR).Formula = "=RC[-12] & "" | "" & RC[-8] & "" | "" & RC[-9] & "" | "" & RC[-6]"

Set Dic = CreateObject("scripting.dictionary")
With mFS
    For Each C1 In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        Dic(C1.Value) = C1.Offset(, 6).Value
    Next C1
End With

With mWD
    For Each C1 In .Range("M2", .Range("A" & Rows.Count).End(xlUp))
        If Dic.exists(C1.Value) Then C1.Offset(, 1).Value = Dic(C1.Value)
    Next C1
End With

Application.DisplayAlerts = False
Application.ScreenUpdating = False

End Sub

 

[Fluff]

You need to use

With mWD
    For Each C1 In .Range("M2:M" & .Range("A" & Rows.Count).End(xlUp).Row)
        If Dic.exists(C1.Value) Then C1.Offset(, 1).Value = Dic(C1.Value)
    Next C1
End With

 

[reberryjr]

You need to use

With mWD
    For Each C1 In .Range("M2:M" & .Range("A" & Rows.Count).End(xlUp).Row)
        If Dic.exists(C1.Value) Then C1.Offset(, 1).Value = Dic(C1.Value)
    Next C1
End With

I made that change, but the results weren't different (I'm still only getting 1 column to copy & paste over to mWD from mFS. The values that I want to copy and paste start with the C1.Offset(,6). The issue is, I want to copy the next 23 columns of data. Something like Range("G:AK")

 

[Fluff]

Which cells should be copied & where to?

 

[reberryjr]

Which cells should be copied & where to?

On mFS, columns G:AD should copy and paste to mWD starting in column N.

 

[Fluff]

Ok, how about

Set Dic = CreateObject("scripting.dictionary")
With mFS
    For Each C1 In .Range("A2", .Range("A" & Rows.count).End(xlUp))
        Dic(C1.Value) = C1.Offset(, 6).Resize(, 24)
    Next C1
End With

With mWD
    For Each C1 In .Range("M2:M" & .Range("A" & Rows.count).End(xlUp).Row)
        If Dic.Exists(C1.Value) Then C1.Offset(, 1).Resize(, 24).Value = Dic(C1.Value)
    Next C1
End With

 

[reberryjr]

Ok, how about

Set Dic = CreateObject("scripting.dictionary")
With mFS
    For Each C1 In .Range("A2", .Range("A" & Rows.count).End(xlUp))
        Dic(C1.Value) = C1.Offset(, 6).Resize(, 24)
    Next C1
End With

With mWD
    For Each C1 In .Range("M2:M" & .Range("A" & Rows.count).End(xlUp).Row)
        If Dic.Exists(C1.Value) Then C1.Offset(, 1).Resize(, 24).Value = Dic(C1.Value)
    Next C1
End With

Works like a champ! So the resize portion is what says how many columns after the offset position to move over. Is that correct?

 

[Fluff]

That's right.