Print labels for items received on receiving report

This looks like fun. You would like the whole selected row to be put on one label?

Hi Learning,

You discribed the direction I would be working. Mailmerge into Word using Label templates would be my first choice.

Other problems: If the user wants to just print one tag, how can the user tell the printer which location of an Avery label sheet gets that tag?

Add as many empty records before filled records as labels have to be bypassed.

OK,

I think that this is a good start. Almost everything is automated and one click does the entire merge, but I need some help:

1. On the RIR (Master Sheet), if the row is blank, you should not be able to put an X in column A to send that (blank) row to the Label sheet.

2. The code that send the rows to the Labels sheet sends over some columns that I don't need for the labels. Only the light-blue headered columns are needed, but the code sends the entire range to the Labels sheet.

3. Probably more for the Word forum, but:
a) The code opens the Word template, does the Merge, creates a new sheet with the merged data, but then leaves the template open. The template should be closed after the new sheet is created.

b) I see alot about Error 429 and multiple instances of Word, so maybe I need some error-checking for that. (It works fine now, but I don't want it to break because of that.)


Here's the code for copying the X'ed rows to the Labels sheet:

Private Sub CommandButton1_Click()
Dim ce As Range
   For Each ce In Range("A8:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        If Not IsEmpty(ce) Then
        With Sheets("Labels")
            .Unprotect "SECRET"
            .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 22).Value = Range(ce, ce.Offset(0, 22)).Value
            ce.ClearContents
            .Select
            .Protect "SECRET"
            End With
        End If
    Next ce
End Sub

Here's the code for the button on the Labels sheet for the merge process:

Private Sub CommandButton2_Click()
Application.ScreenUpdating = True
Application.DisplayAlerts = False

'Opens Word doc
Set wordApp = New Word.Application
wordApp.Visible = True
wordApp.Documents.Open ThisWorkbook.Path & "\Label Template.doc"
With wordApp

'Use Excel to do the Mail Merge
.ActiveDocument.MailMerge.OpenDataSource Name:= _
        ThisWorkbook.Path & "\TagLabelMaker R2.xls", _
        ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:="" _
        , SQLStatement:="SELECT * FROM `Labels$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess


'Display the Merged document
With .ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
End With
End Sub

That's all for now. If anyone has a chance to look at this, I would appreciate the help!

Respectfully,

Lost

Hi snb, I've tried what you gave twice and both times it crashed excel. Plus, I was unable to exit the form (which was nicely laid out by the way). Mayhap it is because I didn't save and tried to run it from within the zip file.

You have to unzip both files in the same directory first.

In the attachment a 'revised revision'

Unzip both files in the same directory: open the Excelfile.

Range("A8:A19" & Cells(Rows.Count, 1).End(xlUp).Row)

doesn't look right.

You can't copy non-contiguous ranges.

Please open the attachment in this post.
You will find the method you are asking for (and much more).

It took me by surprise snb as I haven't had that occur from this site until yesterday. I'm going to try again when I get home from work tonight.

Hi Lost

I must be missing something...this code changes Column H from an "H" to an "A" and places "ITEM ON HOLD" in Column "M". I don't understand this

The program would add an A row (H's always get an A), but then that would make 11 labels.

Private Sub btnEditLabels_Click()
    Dim ce As Range, NR As Long
    For Each ce In Range("A8:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        If Not IsEmpty(ce) Then
            With Sheets("Labels")
                NR = .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Row
                If NR >= 12 Then
                    MsgBox "You already have 10 labels prepared on the Label sheet."
                Else
                    .Unprotect "SECRET"
                    .Cells(NR, "A").Resize(1, 17).Value = Range(ce, ce.Offset(0, 16)).Value
                    If .Cells(NR, "H").Value = "H" Then
                        .Cells(NR, "H").Value = "A"
                        .Cells(NR, "M").Value = "ITEM ON HOLD"
                    End If
                    ce.ClearContents
                    .Select
                    .Protect "SECRET"
                End If
            End With
        End If
    Next ce
End Sub

Tell me what I'm missing.

@Mordred

Originally Posted by Mordred

and I wasn't even able to get past the warning in the beginning because the digital signature is invalid.

You always get a warning when a developer has used selftcert.exe (part of MS Office).
You can 'pass' by accepting the signature as safe (unless you do not trust me at all ). It means that in the future my solutions will run more smoothly on your computer.
I'd say: start accepting my digital signature. After that I hope the rest will be self-evident.

Mordred/snb,

snb: I didn't mean to not acknowledge your post or disrespect you in any way. (Ignorance of the rules is no excuse.) I have your file and have been fiddling with it, but I can't see how I can apply it with what I am trying to do. (Your post has actually got more play (7 views) than the workbook I posted (2 views), so even if I omitted to say anything, it looks like others are seeing that it has value and is getting hits.)

AFA my workbook, I posted on 8/24 the last problem I was having with this workbook before it can go live. I thought maybe that post was getting lost in the shuffle, so I reposted the specific issue to a different thread on 8/24. Without this last issue resolved, the workbook is unusable, and any work leading to this point is lost.

I more than appreciate the help this forum has provided. I realize the help is free and am still waiting for the day when my seed rate overcomes my leach rate.

Lost