# Excel formula lookup multiple charges

I have two spread sheets, one with shipments and another with the charges associated with the shipments.
There are multiple charges to each shipment.

I need to combine - pulling the multiple charges into the same row as the shipment.
Challenges - I don't know how many shipments there will be or how many charges - or how many charges for each shipment.

I attached a sample, in case that helps.
EXAMPLE-LOOKUP.xlsx
###### Who is Participating?

Excel & VBA ExpertCommented:

In the attached, on Shipments Sheet, click the button "Combine Data" to get the desired output.

``````Sub CombineShipmentCharges()
Dim sws As Worksheet, cws As Worksheet
Dim x, y, z, dict
Dim i As Long, j As Long, slr As Long, clr As Long, slc As Long
Dim str
Set sws = Sheets("Shipments")
Set cws = Sheets("Charges")
slr = sws.Cells(Rows.Count, 1).End(xlUp).Row
clr = cws.Cells(Rows.Count, 1).End(xlUp).Row
slc = sws.Cells(1, Columns.Count).End(xlToLeft).Column
If slr < 2 Or clr < 2 Then
Exit Sub
End If
If slc > 10 Then sws.Range("K1", sws.Cells(slr, slc)).Clear
Set dict = CreateObject("Scripting.Dictionary")
x = sws.Range("A2:A" & slr).Value
y = cws.Range("A1").CurrentRegion.Value

For i = 1 To UBound(x, 1)
dict.Item(x(i, 1)) = ""
Next i

For i = 2 To UBound(y, 1)
If dict.Item(y(i, 1)) = "" Then
dict.Item(y(i, 1)) = y(i, 10) & ";" & y(i, 11)
Else
dict.Item(y(i, 1)) = dict.Item(y(i, 1)) & ";" & y(i, 10) & ";" & y(i, 11)
End If
Next i

For i = 1 To UBound(x, 1)
z = Split(dict.Item(x(i, 1)), ";")
sws.Range("K" & i + 1).Resize(1, UBound(z, 1) + 1).Value = z
Next i

slc = sws.UsedRange.Columns.Count
sws.Range("A" & slr + 1).Copy
sws.Range("K2", sws.Cells(slr, slc)).NumberFormat = "#0.00"
sws.Range("K1:L1").Value = Array("Surcharge desc 1", "Surcharge Amount 1")
sws.Range("K1:L1").AutoFill sws.Range("K1", sws.Cells(1, slc)), xlFillDefault
sws.Columns.AutoFit
Set dict = Nothing
End Sub
``````
EXAMPLE-LOOKUP.xlsm
0

Commented:
the question is not clear to me,  what the end result should look like? is it shown in the sheet called "Sample of final"?
0

Author Commented:
Sorry, yes, the final should look like that. The information is compiled from the two other sheets.
I need a formula in the shipments sheet to pull the charges into it.
0

Author Commented:
Excellent - thanks so much!!
0

Author Commented:
Subodh Tiwari (Neeraj), if there are no charges associated with the shipping, I get an error on this line. Can we just have it move on if there are no associated charges?

``````   sws.Range("K" & i + 1).Resize(1, UBound(z, 1) + 1).Value = z
``````
0

Author Commented:
ALSO, I always starts on column K. I don't know how many columns will be in the shipping report. Can it start the first empty column?
0

Excel & VBA ExpertCommented:
Replace existing line#34 with the following....

``````   If UBound(z, 1) >= 0 Then
sws.Range("K" & i + 1).Resize(1, UBound(z, 1) + 1).Value = z
End If
``````

See if that resolves your issue.
0

Author Commented:
Yes - that eliminated the error - thanks!!
0

Excel & VBA ExpertCommented:
Replace the previous code with the following one.
The tweaked code will place the data dynamically on Shipments sheet.

``````Sub CombineShipmentCharges()
Dim sws As Worksheet, cws As Worksheet
Dim x, y, z, dict
Dim i As Long, j As Long, slr As Long, clr As Long, slc As Long, nslc As Long
Dim str
Set sws = Sheets("Shipments")
Set cws = Sheets("Charges")
slr = sws.Cells(Rows.Count, 1).End(xlUp).Row
clr = cws.Cells(Rows.Count, 1).End(xlUp).Row
slc = sws.Cells(1, Columns.Count).End(xlToLeft).Column + 1
If slr < 2 Or clr < 2 Then
Exit Sub
End If
Set dict = CreateObject("Scripting.Dictionary")
x = sws.Range("A2:A" & slr).Value
y = cws.Range("A1").CurrentRegion.Value

For i = 1 To UBound(x, 1)
dict.Item(x(i, 1)) = ""
Next i

For i = 2 To UBound(y, 1)
If dict.Item(y(i, 1)) = "" Then
dict.Item(y(i, 1)) = y(i, 10) & ";" & y(i, 11)
Else
dict.Item(y(i, 1)) = dict.Item(y(i, 1)) & ";" & y(i, 10) & ";" & y(i, 11)
End If
Next i

For i = 1 To UBound(x, 1)
z = Split(dict.Item(x(i, 1)), ";")
If UBound(z, 1) >= 0 Then
sws.Cells(i + 1, slc).Resize(1, UBound(z, 1) + 1).Value = z
End If
Next i

nslc = sws.UsedRange.Columns.Count
sws.Range("A" & slr + 1).Copy
sws.Range(sws.Cells(2, slc), sws.Cells(slr, nslc)).NumberFormat = "#0.00"
sws.Range(sws.Cells(1, slc), sws.Cells(1, nslc)).Value = Array("Surcharge desc 1", "Surcharge Amount 1")
sws.Range(sws.Cells(1, slc), sws.Cells(1, slc + 1)).AutoFill sws.Range(sws.Cells(1, slc), sws.Cells(1, nslc)), xlFillDefault
sws.Columns.AutoFit
Set dict = Nothing
End Sub
``````
0

Author Commented:
PERFECT!  Thanks so much!
0

Excel & VBA ExpertCommented:
You're welcome.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.