Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Excel formula lookup multiple charges

Posted on 2016-08-17
11
Medium Priority
?
90 Views
Last Modified: 2016-08-17
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
0
Comment
Question by:Euro5
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 4
11 Comments
 
LVL 27

Expert Comment

by:ProfessorJimJam
ID: 41759356
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 Comment

by:Euro5
ID: 41759426
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
 
LVL 32

Accepted Solution

by:
Subodh Tiwari (Neeraj) earned 2000 total points
ID: 41759432
Please try this....

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
   MsgBox "Data not found!", vbCritical
   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)).PasteSpecial operation:=xlAdd
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

Open in new window

EXAMPLE-LOOKUP.xlsm
0
Survive A High-Traffic Event with Percona

Your application or website rely on your database to deliver information about products and services to your customers. You can’t afford to have your database lose performance, lose availability or become unresponsive – even for just a few minutes.

 

Author Closing Comment

by:Euro5
ID: 41759462
Excellent - thanks so much!!
0
 

Author Comment

by:Euro5
ID: 41759470
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

Open in new window

0
 

Author Comment

by:Euro5
ID: 41759477
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
 
LVL 32

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41759491
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

Open in new window


See if that resolves your issue.
0
 

Author Comment

by:Euro5
ID: 41759516
Yes - that eliminated the error - thanks!!
0
 
LVL 32

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41759528
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
   MsgBox "Data not found!", vbCritical
   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)).PasteSpecial operation:=xlAdd
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

Open in new window

0
 

Author Comment

by:Euro5
ID: 41759552
PERFECT!  Thanks so much!
0
 
LVL 32

Expert Comment

by:Subodh Tiwari (Neeraj)
ID: 41759556
You're welcome.
0

Featured Post

NEW Veeam Agent for Microsoft Windows

Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

My attempt to use PowerShell and other great resources found online to simplify the deployment of Office 365 ProPlus client components to any workstation that needs it, regardless of existing Office components that may be needing attention.
Ever wonder what it's like to get hit by ransomware? "Tom" gives you all the dirty details first-hand – and conveys the hard lessons his company learned in the aftermath.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…

671 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question