Macro to Count and Mark Items for Printing on Roll

**elgato74** · 02-24-2013, 08:54 AM

Dear All,

please have a look at the attached file.

This list is for printing posters on a plotter with paper rolls of 17.3 meters length. The images have a specific length which is marked in the columns E-H. I would like a Macro to count the images' length and then mark (e.g. Underline ) the last poster image that can fit on the first roll.

Then start to count the remaining ones for the second roll, then third roll etc...

Naturally, it will not always come out even to 17.3 meters, but that does not matter as long as they fit on the roll. So if the result of adding the first 12 items up is e.g. 17.4 meters, it should underline item # 11 and the start to count again with #12.

I hope i explained it well

Thanks so much for your help !

Felix

**mike7952** · 02-24-2013, 10:03 AM

Give this a try

Option Explicit

Sub abc()
 Dim aArrLength, i As Long, c As Long, iCounter
 aArrLength = Range("e2:h2").Value
 
 With CreateObject("scripting.dictionary")
    For i = 1 To UBound(aArrLength, 2)
        .Item(i + 4) = aArrLength(1, i)
    Next
    For i = 3 To Cells(Rows.Count, "a").End(xlUp).Row
        c = Cells(i, Columns.Count).End(xlToLeft).Column
        If .exists(c) Then
            If iCounter + .Item(c) <= 17.3 Then
                iCounter = iCounter + .Item(c)
            Else
               Cells(i - 1, "a").Resize(, 8).Borders(xlEdgeBottom).LineStyle = xlContinuous
               iCounter = .Item(c)
            End If
            
        End If
    Next
 End With
End Sub

**elgato74** · 02-24-2013, 10:08 AM

Perfect !!!!

Thanks so much Mike

**xlbiznes** · 02-24-2013, 11:10 AM

Hi,
Oops , mike has your solution before i could give it to you, Anyways this is my code.

Private Sub print_roll_utilization()
'code by  xlbiznes - Feb 24 2013

Dim counter As Integer
Dim main_loop As Boolean
Dim roll_len As Double
Dim rolls As Integer

'assuming that your data by default will start from row 3

counter = 3
main_loop = True

rolls = 0

If Me.Cells(counter, 1) = "" Then
MsgBox "No Data Found In Row 3 ", vbInformation, "Xlbiznes"
Exit Sub
End If

Do While main_loop = True

If Me.Cells(counter, 5) <> "" Then
   roll_len = roll_len + Me.Cells(2, 5)
Else
   
    If Me.Cells(counter, 6) <> "" Then

    roll_len = roll_len + Me.Cells(2, 6)
    
    Else
        If Me.Cells(counter, 7) <> "" Then
        roll_len = roll_len + Me.Cells(2, 7)
        Else
            If Me.Cells(counter, 8) <> "" Then
            roll_len = roll_len + Me.Cells(2, 8)
            End If
        End If
        
    
    End If
End If


If roll_len > 17.3 Then

Me.Cells(counter - 1, 1).Interior.Color = vbRed
Me.Cells(counter - 1, 1).Font.Color = vbWhite
Me.Cells(counter - 1, 1).Font.Underline = True
rolls = rolls + 1
roll_len = 0
Else
counter = counter + 1
End If

If Me.Cells(counter, 1) = "" Then
main_loop = False
MsgBox "Process Completed - You Would Require " & rolls & " Rolls To Print These Images ", vbInformation, "Xlbiznes"
Exit Sub
End If

Loop

End Sub