PowerPoint 2010 - Recording ticked check boxes into excel

[MHamid]

Hello,

I have the code below that will add the analyst name and date into a specific excel spreadsheet.

I need to update this code that will say if checkboxes are already recorded in excel spreadsheet, skip these and record the ones that were not checked.
For this example I have a userform checklist with 12 checkboxes. I added a button that will record the ticked off check boxes into an excel spreadsheet. If the user only ticks off certain ones and leaves for the day, I will need the code to be able to:
1 - Locate the appropriate spreadsheet that was previously completed
2 - Search through the spreadsheet for any cells in column C and D that have not been ticked off and are not being ticked off to be updated.

Also, I will need the code to save the file in another folder with a specific name tied to the powerpoint name. What is the best option here?

Private Sub RecordData_Click()
Dim xlApp As Object
Dim xlWorkbook As Object
Dim sUserName As String

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Open("i:\CAP_Profile\Desktop\Projects\PPT\QA Checklist\QA Checklist.xlsx", True, False)
sUserName = Environ("username")
          
    If Me.CheckBox1.Value = True Then
        xlWorkbook.sheets(1).Range("C2").Value = sUserName
        xlWorkbook.sheets(1).Range("D2").Value = Now()
    Else
        MsgBox "Check Box 1 Not ticked"
    End If

    If Me.CheckBox2.Value = True Then
        xlWorkbook.sheets(1).Range("C3").Value = sUserName
        xlWorkbook.sheets(1).Range("D3").Value = Now()
    Else
        MsgBox "Check Box 2 Not ticked"
    End If
    
    If Me.CheckBox3.Value = True Then
        xlWorkbook.sheets(1).Range("C4").Value = sUserName
        xlWorkbook.sheets(1).Range("D4").Value = Now()
    Else
        MsgBox "Check Box 3 Not ticked"
    End If
    
    If Me.CheckBox4.Value = True Then
        xlWorkbook.sheets(1).Range("C5").Value = sUserName
        xlWorkbook.sheets(1).Range("D5").Value = Now()
    Else
        MsgBox "Check Box 4 Not ticked"
    End If

    If Me.CheckBox5.Value = True Then
        xlWorkbook.sheets(1).Range("C6").Value = sUserName
        xlWorkbook.sheets(1).Range("D6").Value = Now()
    Else
        MsgBox "Check Box 5 Not ticked"
    End If

    If Me.CheckBox6.Value = True Then
        xlWorkbook.sheets(1).Range("C7").Value = sUserName
        xlWorkbook.sheets(1).Range("D7").Value = Now()
    Else
        MsgBox "Check Box 6 Not ticked"
    End If

    If Me.CheckBox7.Value = True Then
        xlWorkbook.sheets(1).Range("C8").Value = sUserName
        xlWorkbook.sheets(1).Range("D8").Value = Now()
    Else
        MsgBox "Check Box 7 Not ticked"
    End If

    If Me.CheckBox8.Value = True Then
        xlWorkbook.sheets(1).Range("C9").Value = sUserName
        xlWorkbook.sheets(1).Range("D9").Value = Now()
    Else
        MsgBox "Check Box 8 Not ticked"
    End If

    If Me.CheckBox9.Value = True Then
        xlWorkbook.sheets(1).Range("C10").Value = sUserName
        xlWorkbook.sheets(1).Range("D10").Value = Now()
    Else
        MsgBox "Check Box 9 Not ticked"
    End If

    If Me.CheckBox10.Value = True Then
        xlWorkbook.sheets(1).Range("C11").Value = sUserName
        xlWorkbook.sheets(1).Range("D11").Value = Now()
    Else
        MsgBox "Check Box 10 Not ticked"
    End If

    If Me.CheckBox11.Value = True Then
        xlWorkbook.sheets(1).Range("C12").Value = sUserName
        xlWorkbook.sheets(1).Range("D12").Value = Now()
    Else
        MsgBox "Check Box 11 Not ticked"
    End If
    
    If Me.CheckBox12.Value = True Then
        xlWorkbook.sheets(1).Range("C13").Value = sUserName
        xlWorkbook.sheets(1).Range("D13").Value = Now()
    Else
        MsgBox "Check Box 12 Not ticked"
    End If
    
Set xlApp = Nothing
Set xlWorkbook = Nothing

End Sub

Thank you

[westconn1]

you could make a loop for the check boxes like

for cb = 1 to 12
  if me.controls("checkbox" & cb).value = true then
        xlWorkbook.sheets(1).cells(cb + 1, 3).Value = sUserName
        xlWorkbook.sheets(1).cells(cb + 1, 4).Value = Now()
    Else
        MsgBox "Check Box " & cb &" Not ticked"
next

though it still makes a lot of message boxes, probably better just to keep a list and have one message box at the end, showing the list

save the file in another folder with a specific name tied to the powerpoint name.

you can do a xlworkbook.saveAs full\path\filename to make a copy
OR after you close the workbook you can use the name statement to rename /move the file to another folder, as long as it is on the same hard drive, om a different hard drive or network shave you would have to make a filecopy

[MHamid]

Hello,

Below is the updated code:

Option Explicit

Private Sub RecordData_Click()
Dim xlApp As Object
Dim xlWorkbook As Object
Dim sUserName As String
Dim cb As Integer
Dim strMsg As String

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Open("i:\CAP_Profile\Desktop\Projects\PPT\QA Checklist\QA Checklist.xlsx", True, False)
sUserName = Environ("username")
strMsg = ""
          
For cb = 1 To 12
    If Me.Controls("checkbox" & cb).Value = True Then
        xlWorkbook.sheets(1).Cells(cb + 1, 3).Value = sUserName
        xlWorkbook.sheets(1).Cells(cb + 1, 4).Value = Now()
    Else
        strMsg = strMsg & "- " & cb & vbCrLf
    End If
Next

If strMsg <> "" Then MsgBox "Check Box " & vbCrLf & vbCrLf & strMsg & " Not ticked", vbInformation, "Alert!"
  
Set xlApp = Nothing
Set xlWorkbook = Nothing

End Sub

How can I update the code again to say If "QA Checklist.xlsx" file exists in a specific folder, then open the file? But if it does not exist, then open "QA Checklist Template.xlsx" located in a subfolder.

I am trying to figure out the best way to save the file so that the user can open it (via macro) in case they are not complete and had to close out of the file. I want the user to be able to come back to the file and click on the record button in the userform and be able to update the spreadsheet if needed with previously updated data. So, if on day 1 the user only ticked off 5 out of 12 checkboxes, then the macro should save the file as something else in another location. On day 2 the user may want to complete the checklist, so when they click the macro button, the userform will pop-up but when they tick all checkboxes, then the macro will look through the previously saved spreadsheet and update the remaining 7 checkboxes. Therefore, the checklist will have 5 items completed on day 1 (4/9/18) and the remaining 7 checkboxes would be completed on day 2 (4/10/18). Does this make any sense at all or am I asking for too much? Would there be an easier to handle my situation?

Thank you

[westconn1]

Does this make any sense at all or am I asking for too much?

you should be able to this without problem

if not dir("specific\path\QA Checklist.xlsx") = "" then
  set xlbook =workbooks.open("specific\path\QA Checklist.xlsx")
  else
  set xlbook = workbooks.add("subfolder\path\QA Checklist Template.xlsx")  'open new workbook based on template
end if

[MHamid]

Hello,

I have updated my code with your suggestion and added another if statement when reviewing an already existing excel file.

What I need now is to save the excel file based on the pdf file name with the date at the end. Is that possible?
Also, if that is possible then how can I validate if the excel file already exists based on the pdf file name?

Option Explicit

Private Sub RecordData_Click()
Dim xlApp As Object
Dim xlWorkbook As Object
Dim sUserName As String
Dim cb As Integer
Dim strMsg As String

sUserName = Environ("username")
strMsg = ""
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

If Not Dir("i:\CAP_Profile\Desktop\Projects\PPT\QA Checklist\QA Checklist.xlsx") = "" Then
    Set xlWorkbook = xlApp.Workbooks.Open("i:\CAP_Profile\Desktop\Projects\PPT\QA Checklist\QA Checklist.xlsx", True, False)
Else
    Set xlWorkbook = xlApp.Workbooks.Open("i:\CAP_Profile\Desktop\Projects\PPT\QA Checklist\Template\QA Checklist Template.xlsx", True, False)
End If

          
For cb = 1 To 12
    If Me.Controls("checkbox" & cb).Value = True Then
        If xlWorkbook.sheets(1).Cells(cb + 1, 3).Value = "" Then
            xlWorkbook.sheets(1).Cells(cb + 1, 3).Value = sUserName
        End If
        If xlWorkbook.sheets(1).Cells(cb + 1, 4).Value = "" Then
            xlWorkbook.sheets(1).Cells(cb + 1, 4).Value = Now()
        End If
    Else
        strMsg = strMsg & "- " & cb & vbCrLf
    End If
Next
    
If strMsg <> "" Then MsgBox "Check Box " & vbCrLf & vbCrLf & strMsg & " Not ticked", vbInformation, "Alert!"
  
Set xlApp = Nothing
Set xlWorkbook = Nothing

End Sub

Thank you

[westconn1]

you should edit your template file and save it as a workbook template, rather than just a workbook

how can I validate if the excel file already exists based on the pdf file name?

use dir again for the excel file

What I need now is to save the excel file based on the pdf file name with the date at the end. Is that possible?

possible? of course
something like
wkbook .saveas fulldestinationpath\ pdffile name - .pdf +.xlsx

[MHamid]

Hello,

Why would it be best to save the excel file as a workbook template?

Also, what I am looking for is a vba code that will look for the open ppt (sorry not pdf file) file name and save the file based on that name. I don't want to hardcode the file name because this will be a macro that will be used every month for various pdf files and the name will not always be the same.

Thank you

[westconn1]

something like
wkbook .saveas activepresentation.fullname - .pdf + date +.xlsx

wbname = left(activepresentation.fullname, instr(activepresentation.fullname, ".")-1) & format(date,"yyyymmdd") & ".xlsx"
xlworkbook.saveas wbname

untested, you can debug.print wbname to see it it looks correct

[MHamid]

Thanks for the assistance. I tweaked the code to save the file as I need it.

I believe I need one last help to get this to work exactly as I need it. I need to be able to look for a file based on the date. As in look for the file with the same name from the previous day or today's date if there is any based on the filepath name.

Private Sub RecordData_Click()
Dim xlApp As Object
Dim xlWorkbook As Object
Dim sUserName As String
Dim cb As Integer
Dim strMsg As String
Dim filepath As String

sUserName = Environ("username")
strMsg = ""
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

filepath = Left(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") - 1) & Format(Date, "mmddyyyy") & ".xlsx"

If Not Dir("\\namicgdfs\cpna_data_grp\IT RMO PBI\Audit and Control\Metrics Team Development\QUALITY ASSURANCE\QA Checklist\" & filepath) = "" Then
    Set xlWorkbook = xlApp.Workbooks.Open("\\namicgdfs\cpna_data_grp\IT RMO PBI\Audit and Control\Metrics Team Development\QUALITY ASSURANCE\QA Checklist\" & filepath, True, False)
Else
    Set xlWorkbook = xlApp.Workbooks.Open("\\namicgdfs\cpna_data_grp\IT RMO PBI\Audit and Control\Metrics Team Development\QUALITY ASSURANCE\QA Checklist\Template\QA Checklist Template.xlsx", True, False)
End If

Full code:

Option Explicit

Private Sub RecordData_Click()
Dim xlApp As Object
Dim xlWorkbook As Object
Dim sUserName As String
Dim cb As Integer
Dim strMsg As String
Dim filepath As String

sUserName = Environ("username")
strMsg = ""
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

filepath = Left(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") - 1) & Format(Date, "mmddyyyy") & ".xlsx"

If Not Dir("\\namicgdfs\cpna_data_grp\IT RMO PBI\Audit and Control\Metrics Team Development\QUALITY ASSURANCE\QA Checklist\" & filepath) = "" Then
    Set xlWorkbook = xlApp.Workbooks.Open("\\namicgdfs\cpna_data_grp\IT RMO PBI\Audit and Control\Metrics Team Development\QUALITY ASSURANCE\QA Checklist\" & filepath, True, False)
Else
    Set xlWorkbook = xlApp.Workbooks.Open("\\namicgdfs\cpna_data_grp\IT RMO PBI\Audit and Control\Metrics Team Development\QUALITY ASSURANCE\QA Checklist\Template\QA Checklist Template.xlsx", True, False)
End If

          
For cb = 1 To 12
    If Me.Controls("checkbox" & cb).Value = True Then
        If xlWorkbook.sheets(1).Cells(cb + 1, 3).Value = "" Then
            xlWorkbook.sheets(1).Cells(cb + 1, 3).Value = sUserName
        End If
        If xlWorkbook.sheets(1).Cells(cb + 1, 4).Value = "" Then
            xlWorkbook.sheets(1).Cells(cb + 1, 4).Value = Now()
        End If
    Else
        strMsg = strMsg & "- " & cb & vbCrLf
    End If
Next
    
xlWorkbook.SaveAs FileName:="\\namicgdfs\cpna_data_grp\IT RMO PBI\Audit and Control\Metrics Team Development\QUALITY ASSURANCE\QA Checklist\" & filepath
'Debug.Print filepath
    
If strMsg <> "" Then MsgBox "Check Box " & vbCrLf & vbCrLf & strMsg & " Not ticked", vbInformation, "Alert!"
  
Set xlApp = Nothing
Set xlWorkbook = Nothing

End Sub

[westconn1]

as you use the quite long file path in several places, i would store it in a variable or constant

constant serverpath = "\\namicgdfs\cpna_data_grp\IT RMO PBI\Audit and Control\Metrics Team Development\QUALITY ASSURANCE\QA Checklist\"

As in look for the file with the same name from the previous day or today's date

you are already checking for a file with todays date and opening if it exists

what would you want to do if there is a file with yesterdays date?

if not dir(serverpath & Left(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") - 1) & Format(Date - 1, "mmddyyyy") & ".xlsx" = "" then ' yesterday file does exist

Why would it be best to save the excel file as a workbook template?

that is what template files are for, less chance anyone will edit in error, multiple people can open new file based on template at same time without sharing

[MHamid]

Hello,

I want to be able to check for both files. If today's or yesterday's file exists, then open the file. One or the other file will exists, but never both. The purpose is to finish the file the user started yesterday or a few days before. I guess maybe I'm looking for something like look for the file with today's date or the latest date (if the user started the file prior day, a few days ago, or even a few weeks ago).

Thank you

[MHamid]

Hello,

I was able to update the code to the below. However, now that I think about it. If the user starts the file a week ago, then the code will not find that file since it is only looking for the previous day. Would there be a way to say if the filename (with a wildcard for the date) plus the last date modified? That way it will look for the file name with any date plus the last modified file to pull the last modified file with the filename (minus the date).

Option Explicit

Private Sub RecordData_Click()
Dim xlApp As Object
Dim xlWorkbook As Object
Dim sUserName As String
Dim cb As Integer
Dim strMsg As String
Dim filepath As String
Dim filepath2 As String
Dim servepath As String

sUserName = Environ("username")
strMsg = ""
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True

filepath = Left(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") - 1) & "_" & Format(Date, "mmddyyyy") & ".xlsx"
filepath2 = Left(ActivePresentation.Name, InStr(ActivePresentation.Name, ".") - 1) & "_" & Format(Date - 1, "mmddyyyy") & ".xlsx"
servepath = "\\namicgdfs\cpna_data_grp\IT RMO PBI\Audit and Control\Metrics Team Development\QUALITY ASSURANCE\QA Checklist\"

If Not Dir(servepath & filepath2) = "" Then
    If Not Dir(servepath & filepath) = "" Then
        Set xlWorkbook = xlApp.Workbooks.Open(servepath & filepath, True, False)
    Else
        Set xlWorkbook = xlApp.Workbooks.Open(servepath & filepath2, True, False)
    End If
Else
    Set xlWorkbook = xlApp.Workbooks.Open("\\namicgdfs\cpna_data_grp\IT RMO PBI\Audit and Control\Metrics Team Development\QUALITY ASSURANCE\QA Checklist\Template\QA Checklist Template.xlsx", True, False)
End If

Thank you

[MHamid]

Hello,

Please ignore the above two posts from me. The file no longer needs to be saved with the date and therefore should be simpler to just check for the filename itself if it exists.

The last help I need with this code is when the file is being saved.

    xlWorkbook.SaveAs FileName:=servepath & filepath
    'Debug.Print filepath

If the file exists, I get a popup from excel stating that it exists and gives the options to click yes, no, or cancel. I don't want to see this message. how can I bypass this message and overwrite the file if the already exists?

Thank you

[westconn1]

I don't want to see this message

application.displayalerts = false

make sure to turn back on after