Creating labels/pasting an amount specified in a cell - VERY stuck

Andy1984

New member
Joined
Aug 15, 2013
Messages
5
Reaction score
0
Points
0
Hi Everyone,

I have browsed this forum often in the past but have always found a solution to my problem in older posts (my knowledge of VBA is not yet sufficient enough to post replies myself) but this time I am stumped.

I am working for a logistics company who want to produce labels in a quick and easy way so want to use an excel workbook with two sheets. One sheet will have the input criteria, and one will have cells set to a fit size to allow them to print straight onto Avery labels.

Sheet1, the sheet with the input criteria, will use something like drop down boxes with links to cells so you can select hat you want your labels to say and how many of them you would like printed. As each van has different produce, they need more than one description for each van load. When you press a button, I am trying to use VBA to then use this information to enter into the cells in sheet2 so that the labels can be created.
I have put a simplified version below in case my description is inadequate.

7534709_orig.jpg

I have tried using every piece of VBA that I know (not too much) and I just can’t get it to work. Is there anyone out there who could help me with this?
Many thanks,

Andy
 

royUK

New member
Joined
Mar 22, 2011
Messages
155
Reaction score
0
Points
0
Location
Derbyshire, UK
Website
www.excel-it.com
Excel Version(s)
most versions
I've done similar projects before. You need a sheet with the avery labels set out, although I believe you can get a template for word & use Word mailMerge
 

Andy1984

New member
Joined
Aug 15, 2013
Messages
5
Reaction score
0
Points
0
Thank you for your reply. I am looking into mail merge now. I'm just trying to avoid multiple if functions as it will require thousands!
 

NoS

New member
Joined
Jan 17, 2013
Messages
832
Reaction score
0
Points
0
Location
British Columbia
Excel Version(s)
Excel 2010
Am I correct thinking here that your problem is not the actual printing to Avery label sheets but rather getting what to print and how many to print onto the sheet2 layout?

What is the number for the Avery labels you use?

Is the example correct? With 3 labels for bananas and 4 for pears it appears to me that there shouldn't be any for lemons.
 

NoS

New member
Joined
Jan 17, 2013
Messages
832
Reaction score
0
Points
0
Location
British Columbia
Excel Version(s)
Excel 2010
If the answers to my questions is yes then I have a simple VBA solution you can adapt, but you should really read each forums rules about cross-posting.
 

Andy1984

New member
Joined
Aug 15, 2013
Messages
5
Reaction score
0
Points
0
Hi NoS, thank you for your reply. Apologies for the cross posting - I just never thought anyone would be able to help.

Your correct, the problem is not printing the labels, we will be using Avery L7163/J8163 labels but I will format sheet2 to the correct specifications. I am trying to get the writing for the labels to self populate without multiple cut and paste every time. It seems to be further complicated by the fact that we would like the patterns to paste A1, B1, A2, B2 rather than A1, A2, A3 etc.


You're also correct about the lemons - that is a mistake.

Thanks again for replying,

Andy
 

NoS

New member
Joined
Jan 17, 2013
Messages
832
Reaction score
0
Points
0
Location
British Columbia
Excel Version(s)
Excel 2010
You should be able to adapt something along the lines of this into your project.

Code:
Option Explicit

Sub LabelLayout()
    Dim c As Long   'col
    Dim r As Long   'row
    Dim FruitRng As Range
    Dim cel As Range
    Dim i As Integer
    
'clear sheet2 ready for use
Sheets("Sheet2").UsedRange.ClearContents

'set the sheet1 fruit col range to work with
Set FruitRng = Sheets("Sheet1").Range("D5:D" & Sheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row)
    
'run thru range and put onto sheet2
'initialize the start
    r = 1
    c = 1
For Each cel In FruitRng
    i = 1
    If Len(cel.Value) > 0 Then 'the cell is not empty so work with it
        If cel.Offset(0, 1).Value > 0 Then  'there are this many labels reqd
            For i = 1 To cel.Offset(0, 1).Value
                Sheets("Sheet2").Cells(r, c).Value = cel.Value
                c = c + 1
                    If c = 2 Then
                        r = r
                    Else
                        r = r + 1
                    End If
                If c = 3 Then c = 1
                'is pagebreak reqd
                If r > 7 Then
                    If r Mod 7 = 1 Then Sheets("Sheet2").Rows(r).PageBreak = xlPageBreakManual
                End If
            Next i
        End If
    End If
Next cel

End Sub
 

Andy1984

New member
Joined
Aug 15, 2013
Messages
5
Reaction score
0
Points
0
Thank you VERY much, worked an absolute charm. You have saved a lot of people a lot of time :smile:
 
Top