CODEWITHSUNDEEP
excelvbalistloopspaste
class5cat
class5cat

Reputation: 21

How can I compare two sheets and generate a new list using VBA?

Beforehand, be aware that I just began using VBA, and I have few coding experience prior to it.

I have two sheets:

There is one parameter on column A that is definitely on "contacts" sheet, but may be or not be on column A on "public" sheet.

What I'm doing is:

Checking if the parameter contacts.A2 is on public.A2.

If it is, I need to copy columns, on the exact order:

public: A, C, G. contacts: E, F.

I've found the following code online, and I'm running some adaptations to it, but I'm stuck.

Sub match()

Dim I, total, frow As Integer
Dim found As Range

total = Sheets("public").Range("A" & Rows.Count).End(xlUp).Row
'MsgBox (total) '(verifica se a contagem está ok)

For I = 2 To total
   pesquisa = Worksheets("public").Range("A" & I).Value
Set found = Sheets("contacts").Columns("A:A").Find(what:=pesquisa) 'finds a match

If found Is Nothing Then
    Worksheets("result").Range("W" & I).Value = "NO MATCH"
Else
    frow = Sheets("contacts").Columns("A:A").Find(what:=pesquisa).Row
    Worksheets("result").Range("A" & I).Value = Worksheets("public").Range("A" & frow).Value
    Worksheets("result").Range("B" & I).Value = Worksheets("public").Range("C" & frow).Value
    Worksheets("result").Range("C" & I).Value = Worksheets("public").Range("G" & frow).Value
    Worksheets("result").Range("D" & I).Value = Worksheets("contacts").Range("F" & frow).Value
    Worksheets("result").Range("E" & I).Value = Worksheets("contacts").Range("G" & frow).Value
End If
Next I
End Sub

What I expect:

Can you help me?

edited to include samples of the data and expected results:

I believe I can simplify my needs with the images above. I want to check a client on the public sheet, grab the manager contacts (emails) from the contacts sheet, and create a list that contains branch, manager, and both e-mails on the results sheet.

Creating those images, I realized I have forgotten to account for the second parameter (manager), as there can be multiple managers on a branch. So this is another parameter to account for.

`Public sheet (image)

Contacts sheet(image)

Result sheet(image)

spreadsheet

`

Upvotes: 0

Views: 106

Answers (2)

JvdV
JvdV

Reputation: 75840

As per my comments, and your updated question with sample, I do believe that your current results do not match that what you say is required; which is looking for both parameters "Branch" and "Manager". Neither does your expected result look like the columns you wanted to extract according to your question. However, going by your sample data and expected output I tried the following:

Sub BuildList()

'Define your variables
Dim x As Long, y As Long
Dim arr1 As Variant, arr2 As Variant
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

'Fill 1st array variable from sheet Contacts
With Sheet1 'Change accordingly
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr1 = .Range("A2:D" & x).Value
End With

'Fill dictionary with first array
For x = LBound(arr1) To UBound(arr1)
    dict.Add arr1(x, 1) & "|" & arr1(x, 2), arr1(x, 3) & "|" & arr1(x, 4)
Next x

'Fill 2nd array variable from sheet Public
With Sheet2 'Change accordingly
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr2 = .Range("A2:B" & x).Value
End With

'Compare array against dictionary and fill sheet Results
With Sheet3 'Change accordingly
    y = 2
    For x = LBound(arr2) To UBound(arr2)
        If dict.Exists(arr2(x, 1) & "|" & arr2(x, 2)) Then
            .Cells(y, 1).Value = arr2(x, 1)
            .Cells(y, 2).Value = arr2(x, 2)
            .Cells(y, 3).Value = Split(dict(arr2(x, 1) & "|" & arr2(x, 2)), "|")(0)
            .Cells(y, 4).Value = Split(dict(arr2(x, 1) & "|" & arr2(x, 2)), "|")(1)
            y = y + 1
        End If
    Next x
End With

End Sub

This solution makes use of arrays and dictionary which should be fast. It has given me the following result:

enter image description here

Upvotes: 1

xyz
xyz

Reputation: 403

As David suggested, it would be better to have an input and output sample. Maybe you can try this: 

Option Explicit

Public Sub match()

    Dim wsPub As Worksheet
    Dim wsCon As Worksheet
    Dim wsRes As Worksheet
    Dim pubRow As Long
    Dim conRow As Long
    Dim resRow As Long
    Dim i As Long
    Dim rng As Range
    Dim cel As Range
    Dim found As Long
    Dim order(1 To 5) As Integer

    Set wsPub = ThisWorkbook.Worksheets("public")
    Set wsCon = ThisWorkbook.Worksheets("contacts")
    Set wsRes = ThisWorkbook.Worksheets("result")
    pubRow = wsPub.Cells(wsPub.Rows.Count, 1).End(xlUp).Row
    conRow = wsCon.Cells(wsPub.Rows.Count, 1).End(xlUp).Row
    resRow = wsRes.Cells(wsRes.Rows.Count, 1).End(xlUp).Row
    Set rng = wsPub.Range("A2:A" & pubRow)
    order(1) = 1
    order(2) = 3
    order(3) = 7
    order(4) = 6
    order(5) = 7

    For Each cel In rng
        If Not IsError(Application.match(cel.Value, wsCon.Range("A2:A" & conRow), 0)) Then
            found = Application.match(cel.Value, wsCon.Range("A2:A" & conRow), 0) + 1
            resRow = wsRes.Cells(wsRes.Rows.Count, 1).End(xlUp).Row

            For i = 1 To 5
                If i < 4 Then
                    wsRes.Cells(resRow, i).Offset(1, 0).Value _
                    = cel.Offset(0, order(i) - 1).Value
                Else
                    wsRes.Cells(resRow, i).Offset(1, 0).Value _
                    = wsCon.Cells(found, order(i)).Value
                End If
            Next
        End If
    Next

    wsRes.Range("A1").AutoFilter
    wsRes.AutoFilter.Sort.SortFields.Clear
    wsRes.AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("A1:A" & resRow), SortOn:=xlSortOnValues, order:=xlAscending, DataOption:= _
        xlSortNormal
    wsRes.AutoFilter.Sort.Apply

End Sub

Upvotes: 0

Related Questions