Index Match then Merge and Eliminate Duplicates

[MJA001]

Hello,

I'm trying to write a Macro to match and display all the states and cities covered by a sales rep in 2 cells and remove any duplicate information at the same time.

In my spread sheet terms:
If the name in worksheet1 Cell A1, match the name in worksheet2 column C, then:

display the State Name from worksheet2 Column B in Worksheet1 Cell A2 removing duplicate state names,

and display the city name from worksheet2 Column A in Worksheet2 in Worksheet1 Cell B2 removing any duplicate city names and separating each city name by a comma and space.

So it would look like:
A1 = Name of Rep
A2 = Texas B2 = Dallas, Fort Worth, Lubbock, Odessa, Houston

Thanks in advance for the help.

 

[Max1616]

Hello, try this code:

Sub MJA001()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Name As String
Dim lrow1 As Long
Dim lrow2 As Long
Dim i As Long
Dim j As Long
Dim Counter As Long
Dim Cities As String

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

lrow1 = 1
lrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Name = ws1.Cells(1, 1)

For i = 2 To lrow2
    If ws2.Cells(i, 3) = Name Then
        ws1.Cells(lrow1, 2) = ws2.Cells(i, 1)
        lrow1 = lrow1 + 1
    End If
Next i

ws1.Range("B:B").RemoveDuplicates 1, xlNo

lrow1 = ws1.Cells(Rows.Count, 2).End(xlUp).Row

For i = 1 To lrow1
    Counter = 3
    For j = 2 To lrow2
        If ws2.Cells(j, 3) = Name And ws2.Cells(j, 1) = ws1.Cells(i, 2) Then
            ws1.Cells(i, Counter) = ws2.Cells(j, 2)
            Counter = Counter + 1
        End If
    Next j

    For j = 3 To ws1.Cells(i, Columns.Count).End(xlToLeft).Column
        Cities = Cities & ", " & ws1.Cells(i, j)
        ws1.Cells(i, j).ClearContents
    Next j
    
    ws1.Cells(i, 3) = Mid(Cities, 3, 10000)
    Cities = ""
Next i
        
End Sub

This assumes you have headers in sheet 2: State, City, Name, and no headers in sheet1. It also assumes your sheets are names "Sheet1" and "Sheet2", you can change this in the code.

Let me know if you have any questions.

 

[Max1616]

I just realized I forgot to remove duplicate cities. Use this code instead:

Sub MJA001()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Name As String
Dim lrow1 As Long
Dim lrow2 As Long
Dim i As Long
Dim j As Long
Dim Counter As Long
Dim Cities As String

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

lrow1 = 1
lrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Name = ws1.Cells(1, 1)

For i = 2 To lrow2
    If ws2.Cells(i, 3) = Name Then
        ws1.Cells(lrow1, 2) = ws2.Cells(i, 1)
        lrow1 = lrow1 + 1
    End If
Next i

ws1.Range("B:B").RemoveDuplicates 1, xlNo

lrow1 = ws1.Cells(Rows.Count, 2).End(xlUp).Row

For i = 1 To lrow1
    Counter = 3
    For j = 2 To lrow2
        If ws2.Cells(j, 3) = Name And ws2.Cells(j, 1) = ws1.Cells(i, 2) Then
            ws1.Cells(i, Counter) = ws2.Cells(j, 2)
            Counter = Counter + 1
        End If
    Next j

    For j = 3 To ws1.Cells(i, Columns.Count).End(xlToLeft).Column
        If InStr(Cities, ws1.Cells(i, j)) = 0 Then
            Cities = Cities & ", " & ws1.Cells(i, j)
        End If
        ws1.Cells(i, j).ClearContents
    Next j
    
    ws1.Cells(i, 3) = Mid(Cities, 3, 10000)
    Cities = ""
Next i
        
End Sub

 

[MJA001]

Thank you so much! I'll give this a try and will let you know how it works.

 

[MJA001]

It works, but not how I was hoping. Right now each city is populating a single cell in column B and the corresponding state is populated next to it in column C. I would like to have the all of the states populated in cell A2 and all the cities in cell B2, see table below.

MJA001
Texas, Louisiana, Oklahoma	Denton, Dallas, Houston, Lewisville, New Orleans, Baton Rouge, Oklahoma City, Tulsa

<tbody>
</tbody>

 

[Fluff]

How about

Sub GetRepData()

   Dim Qty As Long
   Dim Cnt As Long
   Dim Fnd As Range
   Dim RepName As String
   Dim City As String
   Dim State As String
   
   RepName = Sheets("Sheet1").Range("A1").Value
   With Sheets("Sheet2")
      Set Fnd = .Range("C1")
      Qty = WorksheetFunction.CountIf(.Columns(3), RepName)
      For Cnt = 1 To Qty
         Set Fnd = .Columns(3).Find(RepName, Fnd, , xlWhole, , , False, , False)
         If InStr(1, State, Fnd.Offset(, -1).Value, vbTextCompare) = 0 Then State = State & Fnd.Offset(, -1).Value & ","
         If InStr(1, City, Fnd.Offset(, -2).Value, vbTextCompare) = 0 Then City = City & Fnd.Offset(, -2).Value & ","
      Next Cnt
   End With
   With Sheets("Sheet1")
      .Range("A2") = Left(State, Len(State) - 1)
      .Range("B2") = Left(City, Len(City) - 1)
   End With
End Sub

 

[MJA001]

Fluff,

You are Awesome! This worked perfectly, thank you so much!

 

[Fluff]

Glad we could help & thanks for the feedback