VBA- Automated Packing List Creation

coloradoprincess78 · Oct 25, 2017

I borrowed this from another website and customized it to my specific fields, but it does absolutely nothing.
I am inexperienced with vba, I have done simple vba coding but this is by far the most complicated project I've worked on so far, and after a week of messing around, I'm reaching out for help.

Goal - take data from one spreadsheet (shown below) and create individual packing lists using all vba - would like them to be created based off the packing list number as there could be multiple line items shipped (if possible)
The video that relates to this specific coding does exactly what I need, but it just doesn't work for me.
I can accomplish this with a mail merge if this way doesn't work, but prefer using all excel, especially since I am building this for another department to use on a weekly basis.

Can anyone look at my code and see what errors I made please?
My performance review depends on successfully finishing this project

Excel 2010

	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Customer	Address	City	State	Zip	Packing List No.	PO#	Quantity	Item	Description	Serial Number	Expiration Date	Created ?
2	Oasis	40th Street	Phoenix	AZ	85000	INVTRX00010	7777-1	1	889-987	Sample-987	17-987-001	3/21/2021
3	Oasis	40th Street	Phoenix	AZ	85000	INVTRX00010	7777-1	1	657-888	Sample-888	17-888-001	5/7/2022
4	BigSurf	18th Ave	Tulsa	OK	99999	INVTRX00011	987-123	1	124-342	Sample-342	17-345-001	4/12/2021

ShipmentDetails

Code:

Sub PrintPackingList()
'
' PrintPackingList Macro
'


Dim customername As String
Dim customeraddress As String
Dim invoicenumber As Long
Dim r As Long
Dim mydate As String
Dim path As String
Dim myfilename As String


With ActiveSheet
lastrow = .Cells(“A” & Rows.Count).End(xlUp).Row


r = 2


For r = 2 To lastrow


If Cells(r, 12).Value = “done” Then GoTo nextrow


customername = Sheets(“ShipmentDetails”).Cells(r, 1).Value
customeraddress = Sheets(“ShipmentDetails”).Cells(r, 2).Value
city = Sheets(“ShipmentDetails”).Cells(r, 3).Value
State = Sheets(“ShipmentDetails”).Cells(r, 4).Value
zip = Sheets(“ShipmentDetails”).Cells(r, 5).Value
packinglistnumber = Sheets(“ShipmentDetails”).Cells(r, 6).Value
ponumber = Sheets(“ShipmentDetails”).Cells(r, 7).Value
quantity = Sheets(“ShipmentDetails”).Cells(r, 8).Value
Description = Sheets(“ShipmentDetails”).Cells(r, 9).Value
serialnumber = Sheets(“ShipmentDetails”).Cells(r, 10).Value
ExpirationDate = Sheets(“ShipmentDetails”).Cells(r, 11).Value


Cells(r, 12).Value = “done”
Application.DisplayAlerts = False
ChDir "C:\Invoices"
    Workbooks.Open Filename:="C:\Packing Lists\Packing List.xlsx"
ActiveWorkbook.Sheets(“PackingList”).Activate




ActiveWorkbook.Sheets(“PackingList”).Range(“T8”).Value = packinglistnumber
ActiveWorkbook.Sheets(“PackingList”).Range(“B12”).Value = customername
ActiveWorkbook.Sheets(“PackingList”).Range(“B13”).Value = customeraddress
ActiveWorkbook.Sheets(“PackingList”).Range(“B14”).Value = city
ActiveWorkbook.Sheets(“PackingList”).Range(“B15”).Value = State
ActiveWorkbook.Sheets(“PackingList”).Range(“B16”).Value = zip
ActiveWorkbook.Sheets(“PackingList”).Range(“D19”).Value = ponumber
ActiveWorkbook.Sheets(“PackingList”).Range(“B22”).Value = quantity
ActiveWorkbook.Sheets(“PackingList”).Range(“D22”).Value = Item
ActiveWorkbook.Sheets(“PackingList”).Range(“J22”).Value = Description
ActiveWorkbook.Sheets(“PackingList”).Range(“R22”).Value = serialnumber
ActiveWorkbook.Sheets(“PackingList”).Range(“W22”).Value = ExpirationDate


path = "C:\Packing Lists\"
mydate = Date
mydate = Format(mydate, “mm_dd_yyyy”)




ActiveWorkbook.SaveAs Filename:=path & packinglistnumber & “ - ” & customername & “ - ” & mydate & “.xlsx”
myfilename = ActiveWorkbook.FullName
SetAttr myfilename, vbReadOnly
Application.DisplayAlerts = True
ActiveWorkbook.PrintOut copies:=1


ActiveWorkbook.Close SaveChanges:=False




nextrow:


Next r
 End With


End Sub

igold · Oct 25, 2017

coloradoprincess78 said:
I borrowed this from another website and customized it to my specific fields, but it does absolutely nothing.
I am inexperienced with vba, I have done simple vba coding but this is by far the most complicated project I've worked on so far, and after a week of messing around, I'm reaching out for help.

Goal - take data from one spreadsheet (shown below) and create individual packing lists using all vba - would like them to be created based off the packing list number as there could be multiple line items shipped (if possible)
The video that relates to this specific coding does exactly what I need, but it just doesn't work for me.
I can accomplish this with a mail merge if this way doesn't work, but prefer using all excel, especially since I am building this for another department to use on a weekly basis.

Can anyone look at my code and see what errors I made please?
My performance review depends on successfully finishing this project

Excel 2010

A B C D E F G H I J K L M
1 Customer Address City State Zip Packing List No. PO# Quantity Item Description Serial Number Expiration Date Created ?
2 Oasis 40th Street Phoenix AZ 85000 INVTRX00010 7777-1 1 889-987 Sample-987 17-987-001 3/21/2021
3 Oasis 40th Street Phoenix AZ 85000 INVTRX00010 7777-1 1 657-888 Sample-888 17-888-001 5/7/2022
4 BigSurf 18th Ave Tulsa OK 99999 INVTRX00011 987-123 1 124-342 Sample-342 17-345-001 4/12/2021

<tbody>
</tbody>
ShipmentDetails

Code:

Sub PrintPackingList() ' ' PrintPackingList Macro ' Dim customername As String Dim customeraddress As String Dim invoicenumber As Long Dim r As Long Dim mydate As String Dim path As String Dim myfilename As String With ActiveSheet lastrow = .Cells(“A” & Rows.Count).End(xlUp).Row r = 2 For r = 2 To lastrow If Cells(r, 12).Value = “done” Then GoTo nextrow [COLOR=#ff0000]customername = Sheets(“ShipmentDetails”).Cells(r, 1).Value customeraddress = Sheets(“ShipmentDetails”).Cells(r, 2).Value city = Sheets(“ShipmentDetails”).Cells(r, 3).Value State = Sheets(“ShipmentDetails”).Cells(r, 4).Value zip = Sheets(“ShipmentDetails”).Cells(r, 5).Value packinglistnumber = Sheets(“ShipmentDetails”).Cells(r, 6).Value ponumber = Sheets(“ShipmentDetails”).Cells(r, 7).Value quantity = Sheets(“ShipmentDetails”).Cells(r, 8).Value Description = Sheets(“ShipmentDetails”).Cells(r, 9).Value serialnumber = Sheets(“ShipmentDetails”).Cells(r, 10).Value ExpirationDate = Sheets(“ShipmentDetails”).Cells(r, 11).Value[/COLOR] Cells(r, 12).Value = “done” Application.DisplayAlerts = False ChDir "C:\Invoices" Workbooks.Open Filename:="C:\Packing Lists\Packing List.xlsx" ActiveWorkbook.Sheets(“PackingList”).Activate ActiveWorkbook.Sheets(“PackingList”).Range(“T8”).Value = packinglistnumber ActiveWorkbook.Sheets(“PackingList”).Range(“B12”).Value = customername ActiveWorkbook.Sheets(“PackingList”).Range(“B13”).Value = customeraddress ActiveWorkbook.Sheets(“PackingList”).Range(“B14”).Value = city ActiveWorkbook.Sheets(“PackingList”).Range(“B15”).Value = State ActiveWorkbook.Sheets(“PackingList”).Range(“B16”).Value = zip ActiveWorkbook.Sheets(“PackingList”).Range(“D19”).Value = ponumber ActiveWorkbook.Sheets(“PackingList”).Range(“B22”).Value = quantity ActiveWorkbook.Sheets(“PackingList”).Range(“D22”).Value = Item ActiveWorkbook.Sheets(“PackingList”).Range(“J22”).Value = Description ActiveWorkbook.Sheets(“PackingList”).Range(“R22”).Value = serialnumber ActiveWorkbook.Sheets(“PackingList”).Range(“W22”).Value = ExpirationDate path = "C:\Packing Lists\" mydate = Date mydate = Format(mydate, “mm_dd_yyyy”) ActiveWorkbook.SaveAs Filename:=path & packinglistnumber & “ - ” & customername & “ - ” & mydate & “.xlsx” myfilename = ActiveWorkbook.FullName SetAttr myfilename, vbReadOnly Application.DisplayAlerts = True ActiveWorkbook.PrintOut copies:=1 ActiveWorkbook.Close SaveChanges:=False nextrow: Next r End With End Sub

Hi,

I am just running out but as I was looking at the first part of your code highlighted in red above, your column numbers are not matching your description headings after Column H, due to the fact that you have left out the Item, so every column after column 8 should be +1.

coloradoprincess78 · Oct 25, 2017

igold said:
Hi,

I am just running out but as I was looking at the first part of your code highlighted in red above, your column numbers are not matching your description headings after Column H, due to the fact that you have left out the Item, so every column after column 8 should be +1.

Thank you for catching that, I have corrected my code to include the Item column and corrected the numbering

BrianJN1 · Oct 25, 2017

I note this line in your code:
lastrow = .Cells(“A” & Rows.Count).End(xlUp).Row

I believe that should be reading as:
lastrow = Cells(Rows.Count,"A").End(xlUp).Row

coloradoprincess78 · Oct 26, 2017

BrianJN1 said:
I note this line in your code:
lastrow = .Cells(“A” & Rows.Count).End(xlUp).Row

I believe that should be reading as:
lastrow = Cells(Rows.Count,"A").End(xlUp).Row

Thank you Brian, I could tell there was some type of issue with this piece, it appeared it was looping (maybe not the right term) but wasn't producing any errors.

I have additional errors that I am trying to work through now.

igold · Oct 26, 2017

See if this is close to what you are looking for. Without seeing what your packing list looks like I best guessed on formatting the output to that sheet with multiple item packing lists.

Code:

Sub PrintPackingList()
'
' PrintPackingList Macro
'
    Dim mydate As String
    Dim invoicenumber As Long, r As Long, x As Long, lastrow As Long, i As Long, d As Long
    Dim path As String, myfilename As String
    Dim pln As Variant, shpdtls As Variant, pldtls As Variant
    Dim p As Long, ct As Long, upl As Long


    With ActiveSheet
        lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
        pln = Range("F2:F" & lastrow)
        shpdtls = Range("A2:M" & lastrow)
    End With
    With CreateObject("Scripting.Dictionary")
        For x = LBound(pln) To UBound(pln)
            If Not IsMissing(pln(x, 1)) Then .Item(pln(x, 1)) = 1
        Next
        pln = .Keys
    End With
    ReDim pldtls(1 To lastrow - 1, 1 To 12)
    ct = 1
        For d = LBound(pln) To UBound(pln)
            For r = LBound(shpdtls) To UBound(shpdtls)
                If shpdtls(r, 13) = "done" Then GoTo nextrow
                If shpdtls(r, 6) = pln(d) Then
                    For p = 1 To 12
                        pldtls(ct, p) = shpdtls(r, p)
                    Next
                ct = ct + 1
                End If
nextrow:
            Next
        Dim resp As String
        resp = MsgBox("Processing and Printing Packing List #" & pln(d) _
            & vbNewLine & "Do you wish to continue?", vbYesNo)
        If resp = vbNo Then Exit Sub
        Workbooks.Open Filename:="C:\Packing Lists\Packing List.xlsx"
        ActiveWorkbook.Worksheets("PackingList").Select
            With ActiveSheet
                upl = 1
                .Range("T8").Value = pln(d)
                .Range("B12").Value = pldtls(upl, 1)
                .Range("B13").Value = pldtls(upl, 2)
                .Range("B14").Value = pldtls(upl, 3)
                .Range("B15").Value = pldtls(upl, 4)
                .Range("B16").Value = pldtls(upl, 5)
                .Range("D19").Value = pldtls(upl, 7)
                For upl = 1 To ct
                    .Range("B22").Offset(upl, 0).Value = pldtls(upl, 8)
                    .Range("D22").Offset(upl, 0).Value = pldtls(upl, 9)
                    .Range("J22").Offset(upl, 0).Value = pldtls(upl, 10)
                    .Range("R22").Offset(upl, 0).Value = pldtls(upl, 11)
                    .Range("W22").Offset(upl, 0).Value = pldtls(upl, 12)
                Next
            End With
            path = "C:\Packing Lists\"
            mydate = Format(Date, "mm_dd_yyyy")
            Dim fullPath As String
            ActiveWorkbook.SaveAs Filename:=path & pln(d) & " - " & pldtls(1, 1) & " - " & mydate & ".xlsx"
            myfilename = ActiveWorkbook.FullName
            SetAttr myfilename, vbReadOnly
            Application.DisplayAlerts = True
            ActiveWorkbook.PrintOut copies:=1
            ActiveWorkbook.Close SaveChanges:=False
        Next
        
End Sub

I hope this helps

coloradoprincess78 · Oct 26, 2017

Extremely Close!

No data is pulling into the packing list.

My packing list does not paste here very well, it has a ton of merge fields - is there another way to show you what it looks like?
Not understanding some of this code puts me at a huge disadvantage for troubleshooting.

I really like the way that you revamped this for me so far - you are awesome and I sincerely appreciate your time and effort.

Fluff · Oct 26, 2017

Here's another option (untested)

Code:

Sub PrintPackingList()
'
' PrintPackingList Macro
'


    Dim Cnt As Long
    Dim SDsht As Worksheet
    Dim LastRow As Long
    Dim mydate As String
    Dim path As String
    Dim myfilename As String
    
    LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    Set SDsht = Sheets("ShipmentDetails")
    
    For Cnt = 2 To LastRow
        If Not Cells(Cnt, 13).Value = "done" Then
            
            Workbooks.Open FileName:="C:\Packing Lists\Packing List.xlsx"
            With ActiveWorkbook.Sheets("PackingList")
                .Range("T8").Value = SDsht.Cells(Cnt, 6).Value
                .Range("B12").Value = SDsht.Cells(Cnt, 1).Value
                .Range("B13").Value = SDsht.Cells(Cnt, 2).Value
                .Range("B14").Value = SDsht.Cells(Cnt, 3).Value
                .Range("B15").Value = SDsht.Cells(Cnt, 4).Value
                .Range("B16").Value = SDsht.Cells(Cnt, 5).Value
                .Range("D19").Value = SDsht.Cells(Cnt, 7).Value
                .Range("B22").Value = SDsht.Cells(Cnt, 8).Value
                .Range("D22").Value = SDsht.Cells(Cnt, 9).Value
                .Range("J22").Value = SDsht.Cells(Cnt, 10).Value
                .Range("R22").Value = SDsht.Cells(Cnt, 11).Value
                .Range("W22").Value = SDsht.Cells(Cnt, 12).Value
            End With
            
            path = "C:\Packing Lists\"
            mydate = Date
            mydate = Format(mydate, "mm_dd_yyyy")
            
            ActiveWorkbook.SaveAS FileName:=path & SDsht.Range("F" & Cnt).Value & " - " & SDsht.Range("A" & Cnt).Value & " - " & mydate & ".xlsx"""
            myfilename = ActiveWorkbook.FullName
            SetAttr myfilename, vbReadOnly
            ActiveWorkbook.PrintOut copies:=1
            
            Application.DisplayAlerts = False
            ActiveWorkbook.Close SaveChanges:=False
            Application.DisplayAlerts = True
            
            Cells(Cnt, 13).Value = "done"

        End If
    Next Cnt


End Sub

This will create a separate workbook for each line.
To put multiple lines into 1 workbook, where does 2nd, 3rd line of data need to go?
Item goes to D22 for line 1, would line 2 need to go to D23?

VBA- Automated Packing List Creation

coloradoprincess78

New Member

Excel Facts

igold

Well-known Member

coloradoprincess78

New Member

BrianJN1

Well-known Member

coloradoprincess78

New Member

igold

Well-known Member

coloradoprincess78

New Member

Fluff

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

VBA- Automated Packing List Creation

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

MrExcel MVP, Moderator

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock