troubleshooting Question

VBA - Transfer Data from one sheet to another based on 3 columns

Avatar of Wilder1626
Wilder1626Flag for Canada asked on
VBAMicrosoft ExcelMicrosoft Office
9 Comments1 Solution15 ViewsLast Modified:
Hi again.

This is to follow previous post and adding to the complexity of single values, accept that it will be based on 3 columns.

Instead of transferring based on column "D" value only from "Template" sheet,  now it needs to be per columns "D" , "G" and "AB".

This is again without transferring duplicates values combinations.

If in "Template" sheet i have below:

We see that row 8 and 9 are identical on the 3 columns. So It would only transfer 1 single row. Not the duplicated row.

So in the sheet "Type", i would see below as a result:

This is the code i have so far, but only transfers again based on column "D" only.
I just cannot see how to account for the 3 columns:
For Each V In dict and dict1 and dist2

Open in new window

Full code
Private Sub CommandButton1_Click()
  Dim dict As Object, rCell As Range, dict1 As Object, dict2 As Object
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    Set dict1 = CreateObject("Scripting.Dictionary")
    dict1.CompareMode = vbTextCompare
    Set dict2 = CreateObject("Scripting.Dictionary")
    dict2.CompareMode = vbTextCompare
    With Sheets("Template")
        For Each rCell In .Range("D7:D" & .Cells(.Rows.Count, "D").End(xlUp).Row)
            On Error Resume Next
            dict.Add rCell.Value, rCell.Offset(0, 1).Value
            dict1.Add rCell.Value, rCell.Offset(0, 3).Value
            dict2.Add rCell.Value, rCell.Offset(0, 24).Value
            On Error GoTo 0
        Next rCell
    End With

    With Sheets("Type")
        .UsedRange.Cells.Offset(1, 0).ClearContents

        For Each V In dict

            .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = V
            .Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = dict1(V)
            .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Value = dict1(V)
            .Cells(Rows.Count, 15).End(xlUp).Offset(1, 0).Value = dict2(V)
        Next V
    End With

End Sub

Open in new window

Thanks again for your help.

Macro Transfer single value to other sheet.xlsm
Join our community to see this answer!
Unlock 1 Answer and 9 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 9 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros