Creating 1 row from n rows using concatenate and if then statement

[VBA_Newbie79]

Hello Excel gurus,

As you will see, I am relatively new at this. Using code found on this
forum and other websites, I have developed a macro that will loop through
three columns looking for a row of unique items. I am now having difficulty
concatenating the data from other cells in those combined rows, into one cell.

For example, below is the type of setup the spreadsheet comes in.

City State Country Amount
Restaurant Type
Philadelphia Pennsylvania United States 12 Chinese
Philadelphia Pennsylvania United States 19 Italian
Philadelphia Pennsylvania United States 15 Fast Food
Detroit Michigan United States 7 Chinese
Detroit Michigan United States 10 Italian

This is what I need to see.

City State Country Restaurants
Philadelphia Pennsylvania United States Chinese-12; Italian-19; Fast
Food-15
Detroit Michigan United States Chinese-7; Italian-10

This is the code I pulled together to look at the unique items. Any help
you can provide would be appreciated.
------------------------------------------------
Sub ForMapping()

Dim MapArray()
Dim MapEndRow As Integer
Dim FlowWorkbook As Workbook

Set FlowWorkbook = Workbooks("Flowchart.xls")
MapEndRow = FlowWorkbook.Sheets("DATA").Range("A1").End(xlDown).Row

FlowWorkbook.Activate
ReDim MapArray(1 To MapEndRow - 1)

For x = 2 To MapEndRow
MapArray(x - 1) = FlowWorkbook.Sheets("DATA").Cells(x, 2).Value & _
"_1_" & FlowWorkbook.Sheets("DATA").Cells(x, 3).Value &
"_2_" & _
FlowWorkbook.Sheets("DATA").Cells(x, 4).Value
Next x
UniqueMap = UniqueItems(MapArray(), False)
QUICK_SORT UniqueMap, 1, UBound(UniqueMap)

For x = 1 To UBound(UniqueMap)
tempval2 = InStr(1, UniqueMap(x), "_1_")
tempval3 = InStr(1, UniqueMap(x), "_2_")
FlowWorkbook.Sheets("MapData").Cells(x + 1, 2).Value = _
Left(UniqueMap(x), tempval2 - 1)
FlowWorkbook.Sheets("MapData").Cells(x + 1, 3).Value = _
Mid(UniqueMap(x), tempval2 + 3, ((tempval3) - (tempval2 + 3)))
FlowWorkbook.Sheets("MapData").Cells(x + 1, 4).Value = _
Mid(UniqueMap(x), tempval3 + 3)
Next x

End Sub

 

[FSt1]

hi
are all this info in one cell or in columns?

Regards
FSt1

 

[VBA_Newbie79]

Sorry. They are currently in columns. Thanks for looking at my problem!

 

[Joel]

I did the changes right in the workbook rather than making an arrray.

Sub ForMapping()

Dim MapEndRow As Integer
Dim FlowWorkbook As Workbook

Set FlowWorkbook = ThisWorkbook
' Set FlowWorkbook = Workbooks("Flowchart.xls")

With FlowWorkbook.Sheets("MapData")
Range("A1") = "City"
Range("B1") = "State"
Range("C1") = "Country"
Range("D1") = "Restaurants"
End With

DataRowCount = 2
MapRowCount = 2
NewCity = True
With FlowWorkbook.Sheets("DATA")
Do While .Range("A" & DataRowCount) <> ""

If NewCity = True Then
City = .Range("A" & DataRowCount)
State = .Range("B" & DataRowCount)
Country = .Range("C" & DataRowCount)
With FlowWorkbook.Sheets("MapData")
.Range("A" & MapRowCount) = City
.Range("B" & MapRowCount) = State
.Range("C" & MapRowCount) = Country
End With

NewCity = False
End If

Amount = .Range("D" & DataRowCount)
Restaurant = .Range("E" & DataRowCount)

With FlowWorkbook.Sheets("MapData")
If IsEmpty(.Range("D" & MapRowCount)) Then

.Range("D" & MapRowCount) = .Range("D" & MapRowCount) & _
Restaurant & "-" & Amount
Else
.Range("D" & MapRowCount) = .Range("D" & MapRowCount) & _
"; " & Restaurant & "-" & Amount
End If
End With

If (.Range("A" & DataRowCount) <> .Range("A" & DataRowCount + 1))
Or _
(.Range("B" & DataRowCount) <> .Range("B" & DataRowCount + 1))
Or _
(.Range("C" & DataRowCount) <> .Range("C" & DataRowCount + 1))
Then

MapRowCount = MapRowCount + 1
NewCity = True
End If

DataRowCount = DataRowCount + 1
Loop
End With
End Sub

 

[FSt1]

hi
hope this is what you want.
Sub fixit()
Dim r1 As Range
Dim r2 As Range
Dim d2 As Range
Dim d1 As Range
Set r1 = Range("A2")
Do While Not IsEmpty(r1)
Set r2 = r1.Offset(1, 0)
Set d2 = r1.Offset(0, 4)
Set d1 = r1.Offset(0, 5)
d2.Value = d1.Value & " - " & d2.Value
d1.Value = ""
Set r1 = r2
Loop
End Sub

post back if you have question or if i got it wrong.

Regards
FSt1

 

[VBA_Newbie79]

Both of these suggestions look very promising. I will check them out and let
you know. Thanks Joel & FSt1!

 

[VBA_Newbie79]

Joel,
Your code is working really well. It never occurred to me to work directly
with the workbook. The only problem I'm having, which I neglected to mention
in my original post, is that the unique items don't always have the
duplicates directly beneath them. For example, I need to be able to find all
Philadelphia, PA restaurant numbers and group them together, even if there is
another city's restaurant numbers separating them. Hope I am being clear.
Thanks, again!

 

[VBA_Newbie79]

It appears that if I sort the data first and then apply your code, it
accomplishes what I need. Thank you for your help.