Fill a cell once the file is printed

[Lux Aeterna]

There's an excel form that we fill out and print several times every day. What I need is to have a cell filled every time the sheet is printed.

By the way, we only print as PDF using a macro and an assigned button.

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\Users\pc50\Desktop\Νέα Τεστ Παπ\" & Range("AH1").Value _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True

So, if for example I put ID number 1 (ID number goes to $U$2 - Sheet Test results), I'd like cell B5 (Sheet Demographics) to get filled with the info from $AA$9 (Sheet Test results) as soon as the PDF is printed.
If I put ID number 2, I'd like cell B6 to get the info from $AA$9 and so on. List goes down to cell B10033 (Sheet Demographics).

It would be a great help if the PDF is allowed to be printed only when $AA$9 is filled.

Thank you in advance!

 

[mumps]

In Results you have an ID of "4" in U2 and supervisor "Jill" in AA9. In Demographics you have the name "Jane" corresponding to ID "4". Should the name and ID not match on both sheets? Do you want the supervisor's name in AA9 to be populated automatically based on the data in Results when you enter the ID in U2? This way the supervisor's name will always match the ID and will never be missing.

 

[Lux Aeterna]

No, it's not necessary for the name and ID to not match on both sheets for the warning message to pop up. Sometimes they overwrite their own responses

Not sure about the second suggestion, but I think it's not necessary, as they are forced to enter their ID code each time they give their response.

Maybe an auto-save of the sheet would be useful, because they sometimes close the excel file without saving!

I made some changes in the referred cells, so if possible please work on that code.

Sub Αποθήκευση()
    Application.ScreenUpdating = False
    Dim ID As Range, sup As String, sID As String
    If Sheets("Results").Range("U2") = "" Then
        MsgBox ("Το ID δεν μπορεί να είναι κενό")
        Sheets("Results").Range("U2").Select
        Exit Sub
    End If
    If Sheets("Results").Range("AA9") = "" Then
        MsgBox ("Το κίτρινο κελί δεν μπορεί να είναι κενό")
        Sheets("Results").Range("U3").Select
        Exit Sub
    End If
    Set ID = Sheets("Demographics").Range("A:A").Find(Sheets("Results").Range("U2").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not ID Is Nothing Then
        ID.Offset(, 1) = Sheets("Results").Range("AB9")
    End If
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\Users\pc50\Desktop\New results\" & Range("AH1").Value _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
End Sub

 

[mumps]

Try:

Sub PrintPDF()
    Application.ScreenUpdating = False
    Dim ID As Range, sup As String, sID As String
    If Sheets("Results").Range("AA9") = "" Then
        MsgBox ("Please enter a supervisor name in cell AA9.")
        Sheets("Results").Range("AA9").Select
        Exit Sub
    End If
    If Sheets("Results").Range("U2") = "" Then
        MsgBox ("Please enter an ID in cell U2.")
        Sheets("Results").Range("U2").Select
        Exit Sub
    End If
    Set ID = Sheets("Demographics").Range("A:A").Find(Sheets("Results").Range("U2").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not ID Is Nothing Then
        If MsgBox("This sample has already be tested by ID #" & Sheets("Results").Range("U2") & "." & Chr(10) _
            & "Are you sure you want to overwrite it?", vbYesNo) = vbYes Then
            ID.Offset(, 1) = Sheets("Results").Range("AA9")
        Else
            Sheets("Results").Range("U2").ClearContents
        End If
    End If
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\Users\pc50\Desktop\??a ?est ?ap\" & Range("AH1").Value _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
End Sub

 

[Lux Aeterna]

I get a warning message even if that ID is not already tested (the corresponding cell in Demographics sheet is empty). It's that cell that needs to be filled in to get that warning, not cell U2 in Results sheet. Besides that, If I click Yes, it seems to work fine. If I click No, I get a debug error.

Sheets("Results").Range("U2").ClearContents

Also, where it says

has already been tested by

I need it to take the information from the corresponding cell in column B in the Demographics sheet.

For example, if ID 4 (Demographics sheet, cell A9) has been tested by Jill (Demographics sheet, cell B9) and someone tries to overwrite the same test (ID 4), I need a message saying "This sample has already be tested by Jill. Are you sure you want to overwrite it?). So I think the code might need to change here

Sheets("Results").Range("U2") & "." & Chr(10) _

because as it is now I get this message

 

[mumps]

You should avoid merging cells because they almost always cause problems for macros. You could simply widen a column if you need more space or do a little research into "CenterAcrossSelection". This has the same effect as merging without actually merging any cells. Please unmerge any merged cells and try this macro. Also, "Jill" would be in column C not column B based on the file you posted.

Sub PrintPDF()
    Application.ScreenUpdating = False
    Dim ID As Range, sup As String, sID As String
    If Sheets("Results").Range("AA9") = "" Then
        MsgBox ("Please enter a supervisor name in cell AA9.")
        Sheets("Results").Range("AA9").Select
        Exit Sub
    End If
    If Sheets("Results").Range("U2") = "" Then
        MsgBox ("Please enter an ID in cell U2.")
        Sheets("Results").Range("U2").Select
        Exit Sub
    End If
    Set ID = Sheets("Demographics").Range("A:A").Find(Sheets("Results").Range("U2").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not ID Is Nothing Then
        If MsgBox("This sample has already be tested by " & ID.Offset(, 2) & "." & Chr(10) _
            & "Are you sure you want to overwrite it?", vbYesNo) = vbYes Then
            ID.Offset(, 1) = Sheets("Results").Range("AA9")
        Else
            Sheets("Results").Range("U2").ClearContents
        End If
    End If
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\Users\pc50\Desktop\??a ?est ?ap\" & Range("AH1").Value _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Application.ScreenUpdating = True
End Sub

 

[Lux Aeterna]

I might have posted an older version of the excel file. Supervisor's name is in column B in the most recent one. Managed to fix it though, I changed ID offset from 2 to 1.

However, I get a warning message even if the corresponding cell in column B is empty.

- If I click Yes, the process continues normally.

- If I click No, I still get an error.

Finally, I unmerged the U2 cell, but it is going to be challenging for those who use the file. They will have to click such a small cell (cannot widen it, it will mess the layout of the rest of the form) and believe it or not they already think it is difficult to use! Do you think you can find a bypass and keep the cell merged?

 

[mumps]

Please post an updated file.

 

[Lux Aeterna]

xlbb won't work on my PC. I uploaded the file in my google drive, if that's ok for you.

Google drive link File password is 299.

In the results sheet you need to add any number in the green box. You also need to add either 111 or 222 or 333 or 444 in the orange box for the supervisor name to appear in AA9 (it's a simple if function).

The macro you are working on is assigned to the Save all button.

Thanks once again!

 

[mumps]

I assume that the code is working properly except for the error you get on the "ActiveSheet.ExportAsFixedFormat Type" line. Is this correct? The Demographics sheet doesn't contain any data, so the formulae are returning an error. Should the Demographics sheet not contain data?

 

[Lux Aeterna]

Not sure if this will help, but I'll try to describe what we do.

Demographics sheet contains data that we enter manually (in the whole white colour print_area, except column B). Once we have filled out the print_area columns, the grey columns are auto-filled. Then supervisors enter the ID in the Results sheet to draw the respective data from the Demographics sheet. Once they have done that and put all other necessary info in the Results sheet, they print it out (the macro assigned to "Save all" button) and the supervisor's name is copied to the respective, according to ID, cell in the Demographics sheet column B.

So, there is actually one error and one "unnecessary warning" in the code. The error is the "ActiveSheet.ExportAsFixedFormat Type" line, as you have already said, and it happens when I click No in the warning box.

The unnecessary warning is when the respective cell in Demographics_column B is empty (it has to be empty when a supervisor fills out the Results form).

Hope this answers your question!