Certificate Printing Macro

[Laurenwsjassoc]

Hello,

I need to figure out how to write a macro that will take info from a worksheet (a row that goes across many columns) and place that info in another worksheet that is a certificate template. This macro also needs to recognize when it hits the last filled in column in a row it should print the certificate, move to the next row replace the info in the cert with the date in the next row and then print and keep doing that until it gets to an empty row.

Is this sort of macro possible? If so how do I go about creating it. I know it seems confusing I am happy to answer any questions to clarify.

Thank you!

 

[Laurenwsjassoc]

I can't seem to find the "enable macros" options. I set to medium security but I am still not getting the enable macros option

 

[MrKowz]

I can't seem to find the "enable macros" options. I set to medium security but I am still not getting the enable macros option

Try running a macro. If you cannot, save/close the file and reopen it. If the macros are not there, copy them back into a module like you previously did.

 

[Laurenwsjassoc]

We are getting somewhere! I got it to run! However before it implements the next employees data and creates a new cert it prints 9 blank forms (no column or row titles). Its a blank page with the Main header. I suppose there is a command telling it to print too much.

 

[MrKowz]

No, what is happening is that there may have been some data that extended out to those blank pages at one point and was never properly cleared.

Lets try this:

Public Sub PrintAllCertificates()
Dim i       As Long, _
    LR      As Long, _
    wsData  As Worksheet, _
    wsCert  As Worksheet, _
    trial   As VbMsgBoxResult
 
 
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With
Set wsData = Sheets("Data")
Set wsCert = Sheets("Certificate")
LR = wsData.Range("A" & Rows.Count).End(xlUp).Row
trial = MsgBox("Would you like to run a trial to" & vbLf & "ensure certificate prints properly?", vbYesNo)
If trial = vbNo Then
    For i = 12 To LR
        Application.StatusBar = "Currently printing row " & i & " of " & LR
        wsData.Range("Z1").Value = i
        Application.Calculate
        [B][COLOR=red]wsCert.PrintOut From:=1, To:=1
[/COLOR][/B]    Next i
Else
    For i = 12 To 15
        Application.StatusBar = "Currently printing row " & i & " of 15 (TRIAL RUN)"
        wsData.Range("Z1").Value = i
        Application.Calculate
        [COLOR=red][B]wsCert.PrintOut From:=1, To:=1
[/B][/COLOR]    Next i
End If
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .StatusBar = False
End With
End Sub

 

[Laurenwsjassoc]

It printed all of the employees correctly with no blanks in between...however it didn't stop at the last one. It kept printing infinitely, I had to cancel all print jobs in my printer que and there were about 30. The certs it produced for the blank cells with no names had only one number implemented and it was the same number for all no name certs.

 

[MrKowz]

The code should be stopping when data in column A ends.

Do you have any other data in column A that is below the records?

 

[Laurenwsjassoc]

Your GOOD!! The person who worked on this last had tried to run commands at the bottom of the spread sheet so in row 40 there was info. I cleared contents and it ended with the last employee!!! Thank you so much. I have to work with the initializer a little to fix some of the cells I want to use but other than that I think you have solved my mystery!!!

Thank you again

 

[MrKowz]

Your GOOD!! The person who worked on this last had tried to run commands at the bottom of the spread sheet so in row 40 there was info. I cleared contents and it ended with the last employee!!! Thank you so much. I have to work with the initializer a little to fix some of the cells I want to use but other than that I think you have solved my mystery!!!

Thank you again

Not a problem, glad it works out for you! Thanks for the feedback.

 

[Laurenwsjassoc]

I have been working with your macro all day and it is really helping me get this conversion to excel going! I just have one more issue I'd like to pick your brain about. If there is a cell or cells in my worksheet that are blank for a specific client that I'd like to be omitted in the certificate (or at least to be blank and not have zero's inputed) how would I add that into the initializer portion...specifically its cells AK & AL

If you help me with the verbiage, I feel comfortable enough to play around with it.

Thanks.

 

[MrKowz]

Try:

Public Sub PrintAllCertificates()
Dim i       As Long, _
    LR      As Long, _
    wsData  As Worksheet, _
    wsCert  As Worksheet, _
    trial   As VbMsgBoxResult
 
 
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With
Set wsData = Sheets("Data")
Set wsCert = Sheets("Certificate")
LR = wsData.Range("A" & Rows.Count).End(xlUp).Row
trial = MsgBox("Would you like to run a trial to" & vbLf & "ensure certificate prints properly?", vbYesNo)
If trial = vbNo Then
    For i = 12 To LR
        Application.StatusBar = "Currently printing row " & i & " of " & LR
        wsData.Range("Z1").Value = i
        Application.Calculate
[B][COLOR=red]        If Range("AK" & i).Value <> "" And Range("AL").Value <> "" Then
            wsCert.PrintOut From:=1, To:=1
        End If
[/COLOR][/B]    Next i
Else
    For i = 12 To 15
        Application.StatusBar = "Currently printing row " & i & " of 15 (TRIAL RUN)"
        wsData.Range("Z1").Value = i
        Application.Calculate
[B][COLOR=red]        If Range("AK" & i).Value <> "" And Range("AL").Value <> "" Then
            wsCert.PrintOut From:=1, To:=1
        End If
[/COLOR][/B]    Next i
End If
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .StatusBar = False
End With
End Sub