Page 1 of 2 1 2 LastLast
Results 1 to 10 of 11

Thread: Automatically process form and update master workbook using vba

  1. #1

    Automatically process form and update master workbook using vba



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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
    Last edited by p45cal; 2015-07-25 at 06:47 PM. Reason: added code tags

  2. #2
    Magician NoS's Avatar
    Join Date
    Jan 2013
    Location
    British Columbia
    Posts
    805
    Articles
    0
    Excel Version
    Excel 2010
    Try changing all those Sheetx.somethings to Sheets("Sheetx").something, the same way you have them all in the FormReport() procedure.

  3. #3
    Quote Originally Posted by NoS View Post
    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

  4. #4
    Quote Originally Posted by mobuk View Post
    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.

  5. #5
    Magician NoS's Avatar
    Join Date
    Jan 2013
    Location
    British Columbia
    Posts
    805
    Articles
    0
    Excel Version
    Excel 2010
    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.

  6. #6
    Quote Originally Posted by mobuk View Post
    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
    Attached Files Attached Files

  7. #7
    Sorry my apology. I have now attached. Thanks
    Attached Files Attached Files

  8. #8
    Magician NoS's Avatar
    Join Date
    Jan 2013
    Location
    British Columbia
    Posts
    805
    Articles
    0
    Excel Version
    Excel 2010
    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

  9. #9
    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.
    Attached Files Attached Files

  10. #10
    Magician NoS's Avatar
    Join Date
    Jan 2013
    Location
    British Columbia
    Posts
    805
    Articles
    0
    Excel Version
    Excel 2010
    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.

Page 1 of 2 1 2 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •