VBA- Automated Packing List Creation

C

coloradoprincess78

New Member
Joined
Oct 31, 2016
Messages
14
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 :eeek:

Excel 2010
ABCDEFGHIJKLM
CustomerAddressCityStateZipPacking List No.PO#QuantityItemDescriptionSerial NumberExpiration DateCreated ?
Oasis40th StreetPhoenixAZINVTRX000107777-1889-987Sample-98717-987-001
Oasis40th StreetPhoenixAZINVTRX000107777-1657-888Sample-88817-888-001
BigSurf18th AveTulsaOKINVTRX00011987-123124-342Sample-34217-345-001

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: right"]85000[/TD]

[TD="align: right"]1[/TD]

[TD="align: right"]3/21/2021[/TD]
[TD="align: right"][/TD]

[TD="align: center"]3[/TD]

[TD="align: right"]85000[/TD]

[TD="align: right"]1[/TD]

[TD="align: right"]5/7/2022[/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]

[TD="align: right"]99999[/TD]

[TD="align: right"]1[/TD]

[TD="align: right"]4/12/2021[/TD]
[TD="align: right"][/TD]

</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


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
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
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 :eeek:

Excel 2010
ABCDEFGHIJKLM
CustomerAddressCityStateZipPacking List No.PO#QuantityItemDescriptionSerial NumberExpiration DateCreated ?
Oasis40th StreetPhoenixAZINVTRX000107777-1889-987Sample-98717-987-001
Oasis40th StreetPhoenixAZINVTRX000107777-1657-888Sample-88817-888-001
BigSurf18th AveTulsaOKINVTRX00011987-123124-342Sample-34217-345-001

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: right"]85000[/TD]

[TD="align: right"]1[/TD]

[TD="align: right"]3/21/2021[/TD]
[TD="align: right"][/TD]

[TD="align: center"]3[/TD]

[TD="align: right"]85000[/TD]

[TD="align: right"]1[/TD]

[TD="align: right"]5/7/2022[/TD]
[TD="align: right"][/TD]

[TD="align: center"]4[/TD]

[TD="align: right"]99999[/TD]

[TD="align: right"]1[/TD]

[TD="align: right"]4/12/2021[/TD]
[TD="align: right"][/TD]

</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
Click to expand...

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.
 
Upvote 0
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.
Click to expand...


Thank you for catching that, I have corrected my code to include the Item column and corrected the numbering :)
 
Upvote 0
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
 
Upvote 0
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
Click to expand...


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. :confused:
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
This action cannot be completed because the file is open in word desktop
Replies
1
Views
2K
chipsworld
C
D
  • Question Question
Macro to save file in shared network drive
2
Replies
14
Views
3K
jondavis1987
J
S
  • Question Question
VBA USERFORM : Search and Find a String and Remove from the Combobox List
Replies
8
Views
2K
sykes
sykes
P
  • Question Question
VBA Loop to send emails with 100 email addresses from list on each email
Replies
4
Views
2K
BiocideJ
BiocideJ
A
  • Question Question
List files in 4 specific folder
Replies
0
Views
380
Access Beginner
A

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top