Automatically process form and update master workbook using vba

mobuk · Jul 25, 2015

I have many risk assessors working across the country. Each assessor completes and submits a Ligature Assessment Form via email to me (i.e. Head Quarters) where each form is then processed into a single ligatureMaster Workbook/sheet.

To fully automate the processes, I produced the following/below excel VBA code. The fields/columns in both the Form and the Master Workbooks are the same/identical (i.e. B10:AG10).
But I am having problems - Error 400 or Out of range errors.

Please I need your help.
The main purpose/requirement is when each Assessor completes the form and clicks the single macro button on the form, it should automatically;
1. Copy the form contents and also format the completed form into a PDF
2. Populate/update the 'remote' ligatureMaster workbook with the copied form contents and also attach the PDF format to it
3. Send an email attachment of the copy of the PDF format to me, the Assessor, and the assessor’s manager
4. Clear the Ligature Assessment Form for next use

Please I will be very grateful for your help in solving this.
Your help will be very much appreciated.

The code is as follows, thank you:

Code:

Sub RunAllMacros()
CopyCells
FormReport
Mail_Workbook_Outlook
Clear_LigatureAssessmentForm
End Sub
 
Sub CopyCells()
'written by Mohammad Bukkar
'This code will pick up a range from multiple sheets and add the
'data to the next available range in sheet14 Master sheet
 
'error handler
'On Error GoTo Scooby_Doo:
'unprotect all sheets
'Unprotect_All
'dim variables
  Dim DstRng As Range 'destination range
  Dim SrcRng1 As Range 'sourse range
  
    'destination variable
  Set DstRng = Sheet14.Range("A2")
 ' Set DstRng2 = Sheet6.Range("e5")
  Application.ScreenUpdating = False
 
  If Range("V2") = "" Then
  MsgBox "Please select the assessor's email"
  Exit Sub
  ElseIf Range("AB2") = "" Then
  MsgBox "It appears that you have forgotten to add the date of the assessment"
  Exit Sub
ElseIf Range("AE2") = "" Then
  MsgBox "Please type in name of location"
  Exit Sub
ElseIf Range("AE3") = "" Then
  MsgBox "Please type in location address"
  Exit Sub
ElseIf Range("AE4") = "" Then
  MsgBox "Type in location town/city"
  Exit Sub
ElseIf Range("AE5") = "" Then
  MsgBox "Please type in location post code"
  Exit Sub
ElseIf Range("AE6") = "" Then
  MsgBox "Please type in any omissions on the day of the assessment"
  Exit Sub
ElseIf Range("AB7") = "" Then
  MsgBox "The ligature assessment ID number is missing"
  Exit Sub
 
  Else
   
  'give the user a chance to exit here
  Select Case MsgBox _
  ("You are about to finalise this ligature assessment form." _
  & vbCrLf & "Please check everything before you proceed", _
  vbYesNo Or vbExclamation, "Are you sure?")
        Case vbYes
        Case vbNo
       Exit Sub
       End Select
       End If
  'copy and paste data without selecting
 
  'first sheet
  'sourse variable
    Set SrcRng1 = Sheet1.Range("LigatureAssessmentForm")
    SrcRng1.Copy
    DstRng.End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
   
   
   
   
    Sheet1.Select
    Range("AB7").Value = Range("AB7").Value + 1
'empty clipboard
Application.CutCopyMode = False
'confirmation message
MsgBox "Your ligature assessment form has been sent to Admin" _
& vbCrLf & "and copies have been sent to both you and your managers email"
'clear the ligature assessment form
 
'Exit Sub
End Sub
 
Sub FormReport()
Dim myFile As String, lastRow As Long
myFile = "C:\Users\MB\Desktop\23072015LIGATURE ASSESSMENT FORM.xlsm\" & Sheets("Sheet1").Range("B10") & "_" & Sheets("Sheet1").Range("AG10") & Format(Now(), "yyyy-mm-dd") & ".pdf"
lastRow = Sheets("Sheet14").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
'Transfer data to sheet14
Sheets("Sheet14").Cells(lastRow, 1) = Sheets("Sheet1").Range("B10")
Sheets("Sheet14").Cells(lastRow, 2) = Sheets("Sheet1").Range("C10")
Sheets("Sheet14").Cells(lastRow, 3) = Sheets("sheet1").Range("D10")
Sheets("Sheet14").Cells(lastRow, 4) = Sheets("Sheet1").Range("E10")
Sheets("Sheet14").Cells(lastRow, 5) = Sheets("Sheet1").Range("F10")
Sheets("Sheet14").Cells(lastRow, 6) = Sheets("sheet1").Range("G10")
Sheets("Sheet14").Cells(lastRow, 7) = Sheets("Sheet1").Range("H10")
Sheets("Sheet14").Cells(lastRow, 8) = Sheets("Sheet1").Range("I10")
Sheets("Sheet14").Cells(lastRow, 9) = Sheets("sheet1").Range("J10")
Sheets("Sheet14").Cells(lastRow, 10) = Sheets("Sheet1").Range("K10")
Sheets("Sheet14").Cells(lastRow, 11) = Sheets("Sheet1").Range("L10")
Sheets("Sheet14").Cells(lastRow, 12) = Sheets("sheet1").Range("M10")
Sheets("Sheet14").Cells(lastRow, 13) = Sheets("Sheet1").Range("N10")
Sheets("Sheet14").Cells(lastRow, 14) = Sheets("Sheet1").Range("O10")
Sheets("Sheet14").Cells(lastRow, 15) = Sheets("sheet1").Range("P10")
Sheets("Sheet14").Cells(lastRow, 16) = Sheets("Sheet1").Range("Q10")
Sheets("Sheet14").Cells(lastRow, 17) = Sheets("Sheet1").Range("R10")
Sheets("Sheet14").Cells(lastRow, 18) = Sheets("sheet1").Range("S10")
Sheets("Sheet14").Cells(lastRow, 19) = Sheets("Sheet1").Range("T10")
Sheets("Sheet14").Cells(lastRow, 20) = Sheets("Sheet1").Range("U10")
Sheets("Sheet14").Cells(lastRow, 21) = Sheets("sheet1").Range("V10")
Sheets("Sheet14").Cells(lastRow, 22) = Sheets("Sheet1").Range("W10")
Sheets("Sheet14").Cells(lastRow, 23) = Sheets("Sheet1").Range("X10")
Sheets("Sheet14").Cells(lastRow, 24) = Sheets("sheet1").Range("Y10")
Sheets("Sheet14").Cells(lastRow, 25) = Sheets("Sheet1").Range("Z10")
Sheets("Sheet14").Cells(lastRow, 26) = Sheets("Sheet1").Range("AA10")
Sheets("Sheet14").Cells(lastRow, 27) = Sheets("sheet1").Range("AB10")
Sheets("Sheet14").Cells(lastRow, 28) = Sheets("Sheet1").Range("AC10")
Sheets("Sheet14").Cells(lastRow, 29) = Sheets("Sheet1").Range("AD10")
Sheets("Sheet14").Cells(lastRow, 30) = Sheets("sheet1").Range("AE10")
Sheets("Sheet14").Cells(lastRow, 31) = Sheets("Sheet1").Range("AF10")
Sheets("Sheet14").Cells(lastRow, 32) = Sheets("Sheet1").Range("AG10")
Sheets("Sheet14").Cells(lastRow, 33) = Now
Sheets("Sheet14").Hyperlinks.Add Anchor:=Sheets("Sheet14").Cells(lastRow, 34), Address:=myFile, TextToDisplay:=myFile
'Create invoice in PDF format
Sheets("sheet1").ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile
Application.DisplayAlerts = False
'create invoice in XLSX format
ActiveWorkbook.SaveAs "C:\Users\MB\Desktop\23072015LIGATURE ASSESSMENT FORM.xlsm\" & Sheets("Sheet1").Range("B10") & "_" & Sheets("Sheet1").Range("AG10") & "_" & Format(Now(), "yyyy-mm-dd") & ".xlsx", FileFormat:=52
'ActiveWorkbook.Close
'Application.DisplayAlerts = True
 
End Sub
 
 
 
Sub Mail_Workbook_Outlook()
'Sends the last saved version of the Activeworkbook
    Dim OutApp As Object
    Dim OutMail As Object
 
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = "mobukkar@yahoo.com"
        .CC = "V2"
        .BCC = "AB5"
        .Subject = "Ligature Assessment Form"
        .Body = "Please find attached a copy of the Ligature Assessment Form"
        .Attachments.Add ActiveWorkbook.LigatureAssessmentForm
        .Send
    End With
    On Error GoTo 0
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 
Sub Clear_LigatureAssessmentForm()
'clean up ligature assessment form
Dim Clr As Range
'set variable for range
Set Clr = Sheet1.Range("ClearLigatureAssessmentForm")
'can not use ClearContents because of merged cells so I have set value to ""
Clr.Value = ""
End Sub

NoS · Jul 25, 2015

Try changing all those Sheetx.somethings to Sheets("Sheetx").something, the same way you have them all in the FormReport() procedure.

mobuk · Jul 25, 2015

NoS said:
Try changing all those Sheetx.somethings to Sheets("Sheetx").something, the same way you have them all in the FormReport() procedure.

Thank you NoS, I will try and give feedback. Thanks

mobuk · Jul 26, 2015

mobuk said:
Thank you NoS, I will try and give feedback. Thanks

Hi NoS,

I couldn't get it working. I have therefore attached the two forms and will be very grateful for helping to resolve the issue.

NoS · Jul 26, 2015

Will try helping but you don't have anything attached.

To post a workbook to the forum.

Below the quick reply pane, click go advanced, scroll down and click manage attachments, click add files to browse to your file.

mobuk · Jul 26, 2015

mobuk said:
Hi NoS,

I couldn't get it working. I have therefore attached the two forms and will be very grateful for helping to resolve the issue.

Sorry, my apology. Now attached. Thanks

mobuk · Jul 26, 2015

Sorry my apology. I have now attached. Thanks

NoS · Jul 26, 2015

Yikes... that's all on a sheet module...

Perhaps this will work
have just used A2 for the copy as you have no range named "LigatureAssessmentForm"
and have commented out incrementing AB7 as the sheet is password protected.

Code:

Sub CopyCells()
'dim variables
    Dim SrcRng1 As Range 'sourse range
    Dim DstRng As Range 'destination range
  
Application.ScreenUpdating = False

If Range("V2") = "" Then
      MsgBox "Please select the assessor's email"
      Exit Sub
    ElseIf Range("AB2") = "" Then
      MsgBox "It appears that you have forgotten to add the date of the assessment"
      Exit Sub
    ElseIf Range("AE2") = "" Then
      MsgBox "Please type in name of location"
      Exit Sub
    ElseIf Range("AE3") = "" Then
      MsgBox "Please type in location address"
      Exit Sub
    ElseIf Range("AE4") = "" Then
      MsgBox "Type in location town/city"
      Exit Sub
    ElseIf Range("AE5") = "" Then
      MsgBox "Please type in location post code"
      Exit Sub
    ElseIf Range("AE6") = "" Then
      MsgBox "Please type in any omissions on the day of the assessment"
      Exit Sub
    ElseIf Range("AB7") = "" Then
      MsgBox "The ligature assessment ID number is missing"
      Exit Sub
Else
    
  'give the user a chance to exit here
  Select Case MsgBox("You are about to finalise this ligature assessment form." _
                & vbCrLf & "Please check everything before you proceed", _
                vbYesNo Or vbExclamation, "Are you sure?")
        Case vbYes
        Case vbNo
       Exit Sub
  End Select
End If

'copy and paste data without selecting
'first sheet
'sourse variable
Set SrcRng1 = Sheet1.Range("A2") '("LigatureAssessmentForm")
Set DstRng = Sheet14.Range("A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
SrcRng1.Copy
DstRng.PasteSpecial xlPasteValues

Sheet1.Select
'Range("AB7").Value = Range("AB7").Value + 1
    
'empty clipboard
Application.CutCopyMode = False

'confirmation message
MsgBox "Your ligature assessment form has been sent to Admin" _
& vbCrLf & "and copies have been sent to both you and your managers email"
'clear the ligature assessment form

'Exit Sub
End Sub

mobuk · Jul 27, 2015

Hello NoS,

Thanks. And sorry the doc was password protected. I have unprotected it and have attached it for you. I have paste your code in. The "LigatureAssessmentForm" is a dynamic named range. You see in the attached.

NoS · Jul 28, 2015

In the Sub FormReport(), set a break point by putting your cursor anywhere in the
myFile = "C:\Users\.... line and pressing F9, the line highlights brown.

Go to your LigatureAssessmentForm sheet and click the Submit button
execution of the code will now stop at the myFile line. From here step through the code one line at a time using the F8 key, you will now know exactly what Excel trips over giving the error messages.

You don't have sheets named Sheet1, Sheet2 etc.
Your Sheet14 is named "LigMaster" so you either refer to it by it's codename as Sheet14 or by it's tab name as Sheets("LigMaster")
Sheets("Sheet14") did exist when Excel first inserted the fourteenth sheet into the workbook but not after it was renamed.

Beyond that, I'm afraid I won't be able to help you with this.

mobuk · Jul 28, 2015

NoS said:
In the Sub FormReport(), set a break point by putting your cursor anywhere in the
myFile = "C:\Users\.... line and pressing F9, the line highlights brown.

Go to your LigatureAssessmentForm sheet and click the Submit button
execution of the code will now stop at the myFile line. From here step through the code one line at a time using the F8 key, you will now know exactly what Excel trips over giving the error messages.

You don't have sheets named Sheet1, Sheet2 etc.
Your Sheet14 is named "LigMaster" so you either refer to it by it's codename as Sheet14 or by it's tab name as Sheets("LigMaster")
Sheets("Sheet14") did exist when Excel first inserted the fourteenth sheet into the workbook but not after it was renamed.

Beyond that, I'm afraid I won't be able to help you with this.

Will do so. Thanks a lot. Very much appreciated.

Automatically process form and update master workbook using vba

mobuk

New member

NoS

Member

mobuk

New member

mobuk

New member

NoS

Member

mobuk

New member

Attachments

mobuk

New member

Attachments

NoS

Member

mobuk

New member

Attachments

NoS

Member

mobuk

New member