Add and update collection items and then carry out calucaltions on collected totals.

Michael Roberts
Michael Roberts used Ask the Experts™
on
Hi, I have a list of orders in a workbook. General order information fields start with a 1, Items/goods for that order start with a 0.

I need to be able to firstly add, then find the total number of a items in the collection and then divide that number by a stack height to work out the number of pallet spaces the order will take up.

I have got so far however now i am stuck. i am not even sure that i am approaching this in the right way, so I am open to suggestions
 

Sub thedarkside()
Dim LastRow As Long
    
                With Worksheets("Sheet1").Range("A:O")
                    LastRow = .Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                End With
                
                Dim coll As New Collection
                
                Dim keyword(1 To MAX_KWD), stack(1 To MAX_STACK)
                Dim TotalVolume, e As Long
                Dim p, q, c, r As Range
                Set r = Range("A1:A" & LastRow)
                
                    keyword(1) = "120"
                    keyword(2) = "190"
                    keyword(3) = "240"
                    keyword(4) = "360"
                    keyword(5) = "660"
                    keyword(6) = "770"
                    keyword(7) = "1100"

                    stack(1) = "16"
                    stack(2) = "16"
                    stack(3) = "20"
                    stack(4) = "16"
                    stack(5) = "5"
                    stack(6) = "5"
                    stack(7) = "5"
     
     
                             For Each c In r
                
                                    If c.Value = 1 Then
                                           
                                       
                                        r = 0
                                         TotalVolume = 0
                                          cd = Cells(c.Row, 8).Value
                                         
                                         For i = 1 To MAX_KWD
                                            If (InStr(cd, keyword(i)) > 0) Then
                                            
                                            coll.Add Item:=1, Key:=keyword(i)
                                         
                                            Exit For
                                            Else: End If
                                            
                                        Next i
                                            
                                            Else
                                           
                                    
                                    If c.Value = 0 Then
                                                
                                                cd = Cells(c.Row, 3).Value
                                                e = e + 1
                                                    
                                            For i = 1 To MAX_KWD
                                            If (InStr(cd, keyword(i)) > 0) Then
                                            
                                            coll.Add Item:=cd, Key:=keyword(i) / stack(i)
                                         
                                            Exit For
                                            Else: End If
                                            
                                        Next i
                                                'TotalVolume = Cells(c.row, 19).Value + TotalVolume
                                                'c.Offset(-e, 17).Value = TotalVolume
                                                    
                                                
                                            Else
                                        End If
                                    End If
                                    
                                  
                                        
                                        
                                        For i = 1 To Workbooks.Count
                                            Debug.Print Workbooks(i).Name
                                        Next i
                                        
'                                Debug.Print "R =" & r
'                            Debug.Print "Weight = " & TotalVolume
                                           
                                Next c


End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
I added Code tags around your code to make it easier to read.

Can you attach your workbook?

Also I want to point out that when you do this
Dim p, q, c, r As Range

Open in new window

that only r becomes a Range and the rest are by default Variant so you should do
Dim p As Range
Dim q As Range

Open in new window

etcetera.

Author

Commented:
https://www.experts-exchange.com/questions/29165559/Add-and-update-collection-items-and-then-carry-out-calucaltions-on-collected-totals-Vba-VBA.html#a42987124

Hi thanks for looking into this and your advise ref (Dim p As Range Dim q As Range). i will go back through my modules and edit as suggested. i am new to vba and programming in general. i have attached the workbook i am trying to edit.
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
I have not yet looked at your workbook.

Use this as a starting point.
Sub thedarkside()
Dim LastRow As Long
Dim coll As New Collection
Dim MAX_KWD As Long
Dim MAX_STACK As Long
Dim keyword() As Long
Dim stack() As Long
Dim TotalVolume As Long
Dim e As Long
Dim p As Range
Dim q As Range
Dim c As Range
Dim r As Range

With Worksheets("Sheet1").Range("A:O")
LastRow = .Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With

' I don't know where these values come from so I made them 5 just for this post
MAX_KWD = 5
MAX_STACK = 5

' Note Redim
ReDim keyword(1 To MAX_KWD) As Long
ReDim stack(1 To MAX_STACK) As Long

Set r = Range("A1:A" & LastRow)

keyword(1) = "120"
keyword(2) = "190"
keyword(3) = "240"
keyword(4) = "360"
keyword(5) = "660"
keyword(6) = "770"
keyword(7) = "1100"

stack(1) = "16"
stack(2) = "16"
stack(3) = "20"
stack(4) = "16"
stack(5) = "5"
stack(6) = "5"
stack(7) = "5"


    For Each c In r

        Select Case c.Value
            Case 1
               r = 0
                TotalVolume = 0
                 cd = Cells(c.Row, 8).Value
                
                For I = 1 To MAX_KWD
                   If (InStr(cd, keyword(I)) > 0) Then
                   
                   coll.Add Item:=1, Key:=keyword(I)
                
                   Exit For
                   Else: End If
                   
               Next I
                   
           Case 0
                cd = Cells(c.Row, 3).Value
                e = e + 1
                       
               For I = 1 To MAX_KWD
                   If (InStr(cd, keyword(I)) > 0) Then
                   
                        coll.Add Item:=cd, Key:=keyword(I) / stack(I)
                
                        Exit For
                    End If
               Next I
                       'TotalVolume = Cells(c.row, 19).Value + TotalVolume
                       'c.Offset(-e, 17).Value = TotalVolume
                           
                       
        Case Else
            ' I don't know what you want to do when c.Value is not 0 or 1
'               End If
'           End If
'
'
'
'
'               For i = 1 To Workbooks.Count
'                   Debug.Print Workbooks(i).Name
'               Next i
               
'                                Debug.Print "R =" & r
'                            Debug.Print "Weight = " & TotalVolume
    End Select
                  
       Next c


End Sub

Open in new window

HTML5 and CSS3 Fundamentals

Build a website from the ground up by first learning the fundamentals of HTML5 and CSS3, the two popular programming languages used to present content online. HTML deals with fonts, colors, graphics, and hyperlinks, while CSS describes how HTML elements are to be displayed.

Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
How is "stack height" determined?

Once the calculation is done, what do you want to do with the result?

Author

Commented:
Hi the stack hight is determined by the the type of  item and it relating volume soo for example i could have 15 x 1100 with a stack height of 5 so it would be 3 pallet space applied to the column 16 (est volume)

 number of containers 22 x 1100ltr / stack hight of 5 would be 5 pallets space round up to the whole number

 keyword(1) = "120", has a stack hieght of , stack(1) = "16"...  ect.

once calculated the answer to go in column 16 of the general infomation line starting with a zero.
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
How do I know that keyword 120 is associated with the Meadowfield School order?
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
In addition to my previous question, I don't understand your explanation of how you get to 5. I see that the sum of D3 to D5 is 22, and I see that there is 1100 in column H3, but you seem to be ignoring H4 and H5.

A couple of comments about the workbook:

  • Instead of the (to my old eyes) unreadable text in column F, you can insert a comment in the cell instead, and, optionally, replace the text with something like "Description".
  • If you format column D as Text, you wouldn't need the single quotes in front of the numbers.

Author

Commented:
hi, thanks for looking into this and your advice. i was at work before and very rushed my apologies for this confusing file .  

i have faced many problems with cleaning up this sheet however this is the last part we are currently looking into.

To give a little back ground.

this sheet is made up of sales orders that are imported from multiple  csv files.(1 order per file) . the raw data dose not contain all the data i need, so i am trying to fabricate the  missing information needed from the information present in the file and the subject of the email it is downloaded from.

rows starting with 1 (column A) = general order information this is always the top row of the single sales order csv it originated from.
rows starting  with 0 below are product lines associated the above row starting 1 above.  

when there is another row starting 1 it is treated as a new sales order and it has it product information below starting zero.  this keeping going.

the main problem here is i have only been given 1 csv file so far. As this is prep for the the new data import about to go live at work.  and i have simply been altering the data manually to create test data. so we are working we test data hence the same order repeated 10 times over.

erm overall aim is to summarize the total of each different product line per order. when divide the summarized total by its stack height

 (in this case they are dealing with 4 wheeled waste containers that are sold in signals but delivered stack together.)


row E = quantity.
row H= Item type

meadow field order

12 x 1100 waste containers in total over two different lines. 1100ltrs are stacked in 5's so 12/5= 2.4 which is always rounded up to the nearest whole number so 3.

10 x 660ltr / stack 5 = 2. so the total freight space required is 5 pallet spaces.

to be fair i real appreciate your help but i think i need to approach this a different way. at present i am just trying to replicate some script i wrote in previous module.

i think maybe need to apply each item  to a dictionary and update the qty as it travels through the zeros of an sales order.

i cant really alter the core/raw information in the file as it is used at a later date.

Once again thanks.
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
i think maybe need to apply each item  to a dictionary and update the qty as it travels through the zeros of an sales order.
I may not understand completely, but couldn't that be done with formulas?

Should P3, 4 and 5 all have an estimate or just P3?

Author

Commented:
p2 should contain the total estimate.

p3, 4, 5 should all have estimates. that i have been try to calculate the most most radical way going

this should be done with formulas your right i think i need to review my approach.  if i put estimates against each row the then just sum the total in P2...  i will look into that. cheers

Author

Commented:
erm this is what i have hacked away at.
 i have it working. maybe sightly different than your average but it works   :)

thanks for your help with this

 

Sub TotalVolume()

        Private Const MAX_KWD = 10
        Private Const MAX_STACK = 10
        Sub TotalVolume()
        
        Dim keyword(1 To MAX_KWD)
        Dim stack(1 To MAX_STACK)
        Dim p As Range
        Dim q As Range
        Dim c As Range
        Dim r As Long
        Dim TotalVolume As Long
        Dim LastRow As Long
        Dim cd As String
        
        With Worksheets("Sheet1").Range("A:O")
            LastRow = .Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        End With
                  
        keyword(1) = "120"
        keyword(2) = "190"
        keyword(3) = "240"
        keyword(4) = "360"
        keyword(5) = "660"
        keyword(6) = "770"
        keyword(7) = "1100"

        stack(1) = "16"
        stack(2) = "16"
        stack(3) = "20"
        stack(4) = "16"
        stack(5) = "5"
        stack(6) = "5"
        stack(7) = "5"

            
            Set q = Range("A1:A" & LastRow)
                    
                    For Each p In q
                    
                    
                    
                    
                        If p.Value = 1 Then
                        
                        
                        
                        Else
                        
                        
                        If p.Value = 0 Then
                         
                            
                            cd = Cells(p.Row, 3).Value
                                  
                                For i = 1 To MAX_KWD
                                
                                    If (InStr(cd, keyword(i)) > 0) Then
                                    Cells(p.Row, 16).Value = Cells(p.Row, 5).Value / stack(i)
                                    Exit For
                                    Else: End If
                                    
                                Next i
                                
                                If (i = MAX_KWD) Then ' not found
                                           
                                Else ' Found
                                 
                                End If
                            
                            End If
                        End If

                        Next
                        
                    
                    
                    For Each c In q
                
                                    If c.Value = 1 Then
                                           
                                       
                                        r = 0
                                         TotalVolume = 0
                                            
                                            Else
                                           
                                    
                                            If c.Value = 0 Then
                                        
                                                r = r + 1
                                                
                                                TotalVolume = Cells(c.Row, 16).Value + TotalVolume
                                                
                                                c.Offset(-r, 15).Value = Application.WorksheetFunction.RoundUp(TotalVolume, 0)
                                                
                                                
                                            Else
                                        End If
                                    End If
                                        
                                Debug.Print "R =" & r
                            Debug.Print "TotalVolume = " & TotalVolume
                                           
                        Next c
                       
                    
                        
End Sub

Open in new window

Older than dirt
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
This puts the pallet count in the '0' rows. You can add formulas in the '1' rows. If you want an explanation of the code just ask.

Sub PalletCounts()
Dim lngRow As Long
Dim lngLastRow As Long
Dim lngEntry As Long
Dim rngF As Range
Dim arrKeyWord As Variant
Dim arrStack As Variant

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    arrKeyWord = Array("120", "190", "240", "360", "660", "770", "1100")
    arrStack = Array("16", "16", "20", "16", "5", "5", "5")

    With ActiveSheet
        lngLastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        For lngRow = 3 To lngLastRow
            If Cells(lngRow, "A") = 0 Then
                ' Do calc
                For lngEntry = 0 To UBound(arrKeyWord)
                    If Val(Cells(lngRow, "H")) = arrKeyWord(lngEntry) Then
                        Cells(lngRow, "P") = Application.WorksheetFunction.RoundUp(Cells(lngRow, "E") / arrStack(lngEntry), 0)
                    End If
                Next
            End If
        Next
        
    End With
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With

End Sub 

Open in new window

Author

Commented:
Nice. thanks. always good to see the right way to approach a specific task.  some interesting points of learning for me. not sure how relevant the answer is to my initial question...but it was fun getting there.
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
not sure how relevant the answer is to my initial question
To make mine like yours you only need to place Sum formulas in P2, P6, etc. Or the code could be changed to add the sums in the '1' rows.

In any case you’re welcome and I’m glad I was able to help.

If you expand the “Full Biography" section of my profile you’ll find links to some articles I’ve written that may interest you.

Marty - Microsoft MVP 2009 to 2017
              Experts Exchange Most Valuable Expert (MVE) 2015, 2017
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2018
              Experts Exchange Top Expert VBA 2018
              Experts Exchange Distinguished Expert in Excel 2018

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial