Incremented Cell Value by printing

M

MBendahib

New Member
Joined
Aug 13, 2017
Messages
7
Hello,
Good evening,
I need your help to get a solution for my question, I made a pallet label with an excel sheet, the value of the cell (A15) contains the value of the pallet ID (For example: PID00521), the cell (A17) contains the barcode of (A15). I want to make the value of the pallet ID cell encrements automatically by printing many copies of the same label, for example (Number of copies 3 > 1st label PID00521, 2nd label PID00522, 3rd label PID00523)
Your help will be greatly appreciated :)
Thnks
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
Re: Encremanted Cell Value by printing

Hi,

This code will work, but only for 3 digit numbers, you'll need to adjust the left/right or come up with a better solution for the string/numerical combination in A15 once you reach PID01000.

Code: 
Sub printlabel()

Dim palletno As Long
Dim nolabels As Long
Dim stopprint As Long
Dim palletprefix As String


palletprefix = Left(Range("A15").Value, 5) 'text - [COLOR=#333333][FONT=Verdana]PID00[/FONT][/COLOR]
palletno = Right(Range("A15").Value, 3) 'numerical - [COLOR=#333333][FONT=Verdana]523[/FONT][/COLOR]
nolabels = InputBox("Enter no. of pallet labels")


stopprint = 0


Do Until stopprint = nolabels
    Range("A15:A17").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    stopprint = stopprint + 1
    palletno = palletno + 1
    Range("A15").Value = palletprefix & palletno
Loop




End Sub
 
Last edited:
Upvote 0
Re: Encremanted Cell Value by printing

This will handle the 3 to 4 digit change.

Code: 
Sub printlabel()


Dim palletno As Long
Dim nolabels As Long
Dim stopprint As Long
Dim palletprefix As String


palletprefix = Left(Range("A15").Value, 5)
palletno = Val(Right(Range("A15").Value, 3))
nolabels = InputBox("Enter no. of pallet labels")


stopprint = 1


Do Until stopprint = nolabels Or palletno = 999
    Range("A15:A17").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    stopprint = stopprint + 1
    palletno = palletno + 1
    Range("A15").Value = palletprefix & palletno
Loop


    palletprefix = Left(Range("A15").Value, 4)
    palletno = Right(Range("A15").Value, 4)


    Do Until stopprint = nolabels
        Range("A15:A17").Select
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
        stopprint = stopprint + 1
        palletno = palletno + 1
        Range("A15").Value = palletprefix & palletno
    Loop


End Sub
 
Last edited:
Upvote 0
Hi @mrshl9898,

It works great, thank you for your help, but I just want to know if it is possible to make it works with 7 digits after "HNK", For example (HNK0000001, HNK0000002, HNK0000003 .... HNK0010999, HNK0011000, HNK0011001 ...etc)

Thank you so much in advance :) :)
 
Upvote 0
Hi,

This should handle XXX000001-XXX999999 and XXX0000001-XXX9999999. Although I have not tested it.

Let me know if any issues.


Code: 
Sub printlabel()



Dim palletno As Long
Dim nolabels As Long
Dim stopprint As Long
Dim palletprefix As String
Dim labellength As Long


labellength = Len(Range("A15").Value)


If labellength = 10 Then
palletprefix = Left(Range("A15").Value, 9)
palletno = Val(Right(Range("A15").Value, 1))
nolabels = InputBox("Enter no. of pallet labels")
End If


If labellength = 9 Then
palletprefix = Left(Range("A15").Value, 8)
palletno = Val(Right(Range("A15").Value, 1))
nolabels = InputBox("Enter no. of pallet labels")
Else
Exit Sub
End If


stopprint = 1


Do Until stopprint = nolabels Or palletno = 9
    Range("A15:A17").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    stopprint = stopprint + 1
    palletno = palletno + 1
    Range("A15").Value = palletprefix & palletno
Loop


    If labellength = 10 Then
    palletprefix = Left(Range("A15").Value, 8)
    palletno = Right(Range("A15").Value, 2)
    Else 'assuming labellength = 9
    palletprefix = Left(Range("A15").Value, 7)
    palletno = Val(Right(Range("A15").Value, 2))
    nolabels = InputBox("Enter no. of pallet labels")
    End If


    Do Until stopprint = nolabels Or palletno = 99
        Range("A15:A17").Select
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
        stopprint = stopprint + 1
        palletno = palletno + 1
        Range("A15").Value = palletprefix & palletno
    Loop
    
        If labellength = 10 Then
        palletprefix = Left(Range("A15").Value, 7)
        palletno = Right(Range("A15").Value, 3)
        Else 'assuming labellength = 9
        palletprefix = Left(Range("A15").Value, 6)
        palletno = Val(Right(Range("A15").Value, 3))
        nolabels = InputBox("Enter no. of pallet labels")
        End If


        Do Until stopprint = nolabels Or palletno = 999
            Range("A15:A17").Select
            ActiveWindow.SelectedSheets.PrintOut Copies:=1
            stopprint = stopprint + 1
            palletno = palletno + 1
            Range("A15").Value = palletprefix & palletno
        Loop
    
            If labellength = 10 Then
            palletprefix = Left(Range("A15").Value, 6)
            palletno = Right(Range("A15").Value, 4)
            Else 'assuming labellength = 9
            palletprefix = Left(Range("A15").Value, 5)
            palletno = Val(Right(Range("A15").Value, 4))
            nolabels = InputBox("Enter no. of pallet labels")
            End If


            Do Until stopprint = nolabels Or palletno = 9999
                Range("A15:A17").Select
                ActiveWindow.SelectedSheets.PrintOut Copies:=1
                stopprint = stopprint + 1
                palletno = palletno + 1
                Range("A15").Value = palletprefix & palletno
            Loop
            
                If labellength = 10 Then
                palletprefix = Left(Range("A15").Value, 5)
                palletno = Right(Range("A15").Value, 5)
                Else 'assuming labellength = 9
                palletprefix = Left(Range("A15").Value, 4)
                palletno = Val(Right(Range("A15").Value, 5))
                nolabels = InputBox("Enter no. of pallet labels")
                End If


                Do Until stopprint = nolabels Or palletno = 99999
                    Range("A15:A17").Select
                    ActiveWindow.SelectedSheets.PrintOut Copies:=1
                    stopprint = stopprint + 1
                    palletno = palletno + 1
                    Range("A15").Value = palletprefix & palletno
                Loop
    
                    If labellength = 10 Then
                    palletprefix = Left(Range("A15").Value, 4)
                    palletno = Right(Range("A15").Value, 6)
                    Else 'assuming labellength = 9
                    palletprefix = Left(Range("A15").Value, 3)
                    palletno = Val(Right(Range("A15").Value, 6))
                    nolabels = InputBox("Enter no. of pallet labels")
                    End If


                    Do Until stopprint = nolabels Or palletno = 999999
                        Range("A15:A17").Select
                        ActiveWindow.SelectedSheets.PrintOut Copies:=1
                        stopprint = stopprint + 1
                        palletno = palletno + 1
                        Range("A15").Value = palletprefix & palletno
                    Loop
                    
                        If labellength = 10 Then
                        palletprefix = Left(Range("A15").Value, 3)
                        palletno = Right(Range("A15").Value, 7)
                        Else
                        Exit Sub
                        End If


                        Do Until stopprint = nolabels Or palletno = 9999999
                            Range("A15:A17").Select
                            ActiveWindow.SelectedSheets.PrintOut Copies:=1
                            stopprint = stopprint + 1
                            palletno = palletno + 1
                            Range("A15").Value = palletprefix & palletno
                        Loop


End Sub
 
Last edited:
Upvote 0
Hi mrshl9898

I would to thank you for your help, I really appreciate it

The code doesn't work, when I enter the number of label that I want to print + Ok, the printer wont print.

Thank you again for your help!!
 
Upvote 0
Sorry about that, a bit silly on my part. Fixed.

Code: 
Sub printlabel()

Dim palletno As Long
Dim nolabels As Long
Dim stopprint As Long
Dim palletprefix As String
Dim labellength As Long


labellength = Len(Range("A15").Value)


If labellength = 10 Then
palletprefix = Left(Range("A15").Value, 9)
palletno = Val(Right(Range("A15").Value, 1))
nolabels = InputBox("Enter no. of pallet labels")
ElseIf labellength = 9 Then
palletprefix = Left(Range("A15").Value, 8)
palletno = Val(Right(Range("A15").Value, 1))
nolabels = InputBox("Enter no. of pallet labels")
Else
Exit Sub
End If


stopprint = 0


Do Until stopprint = nolabels Or palletno = 9
    Range("A15:A17").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    stopprint = stopprint + 1
    palletno = palletno + 1
    Range("A15").Value = palletprefix & palletno
Loop




    If labellength = 10 Then
    palletprefix = Left(Range("A15").Value, 8)
    palletno = Right(Range("A15").Value, 2)
    Else 'assuming labellength = 9
    palletprefix = Left(Range("A15").Value, 7)
    palletno = Val(Right(Range("A15").Value, 2))
    nolabels = InputBox("Enter no. of pallet labels")
    End If




    Do Until stopprint = nolabels Or palletno = 99
        Range("A15:A17").Select
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
        stopprint = stopprint + 1
        palletno = palletno + 1
        Range("A15").Value = palletprefix & palletno
    Loop
    
        If labellength = 10 Then
        palletprefix = Left(Range("A15").Value, 7)
        palletno = Right(Range("A15").Value, 3)
        Else 'assuming labellength = 9
        palletprefix = Left(Range("A15").Value, 6)
        palletno = Val(Right(Range("A15").Value, 3))
        nolabels = InputBox("Enter no. of pallet labels")
        End If




        Do Until stopprint = nolabels Or palletno = 999
            Range("A15:A17").Select
            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
            stopprint = stopprint + 1
            palletno = palletno + 1
            Range("A15").Value = palletprefix & palletno
        Loop
    
            If labellength = 10 Then
            palletprefix = Left(Range("A15").Value, 6)
            palletno = Right(Range("A15").Value, 4)
            Else 'assuming labellength = 9
            palletprefix = Left(Range("A15").Value, 5)
            palletno = Val(Right(Range("A15").Value, 4))
            nolabels = InputBox("Enter no. of pallet labels")
            End If




            Do Until stopprint = nolabels Or palletno = 9999
                Range("A15:A17").Select
                ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
                stopprint = stopprint + 1
                palletno = palletno + 1
                Range("A15").Value = palletprefix & palletno
            Loop
            
                If labellength = 10 Then
                palletprefix = Left(Range("A15").Value, 5)
                palletno = Right(Range("A15").Value, 5)
                Else 'assuming labellength = 9
                palletprefix = Left(Range("A15").Value, 4)
                palletno = Val(Right(Range("A15").Value, 5))
                nolabels = InputBox("Enter no. of pallet labels")
                End If




                Do Until stopprint = nolabels Or palletno = 99999
                    Range("A15:A17").Select
                    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
                    stopprint = stopprint + 1
                    palletno = palletno + 1
                    Range("A15").Value = palletprefix & palletno
                Loop
    
                    If labellength = 10 Then
                    palletprefix = Left(Range("A15").Value, 4)
                    palletno = Right(Range("A15").Value, 6)
                    Else 'assuming labellength = 9
                    palletprefix = Left(Range("A15").Value, 3)
                    palletno = Val(Right(Range("A15").Value, 6))
                    nolabels = InputBox("Enter no. of pallet labels")
                    End If




                    Do Until stopprint = nolabels Or palletno = 999999
                        Range("A15:A17").Select
                        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
                        stopprint = stopprint + 1
                        palletno = palletno + 1
                        Range("A15").Value = palletprefix & palletno
                    Loop
                    
                        If labellength = 10 Then
                        palletprefix = Left(Range("A15").Value, 3)
                        palletno = Right(Range("A15").Value, 7)
                        Else
                        Exit Sub
                        End If




                        Do Until stopprint = nolabels Or palletno = 9999999
                            Range("A15:A17").Select
                            ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
                            stopprint = stopprint + 1
                            palletno = palletno + 1
                            Range("A15").Value = palletprefix & palletno
                        Loop




End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Update =getimage() inbetween VBA prints
Replies
0
Views
130
Bajjonetaz
B
C
  • Question
Scan and conditional print
Replies
0
Views
345
Cristigal
C
H
  • Solved
VBA code to copy value from user input to other sheet
Replies
6
Views
392
hendyhellen
H
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
448
AndyEd
A
E
  • Question
Print an Array to PDF only the tabs if Value in Cell is Greater than 0
Replies
4
Views
105
ExcelError
E

Forum statistics

Threads
1,215,387
Messages
6,124,633
Members
449,177
Latest member
Sousanna Aristiadou

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