Help Cleaning Up / Optimizing VBA Code

E

elitef

Board Regular
Joined
Feb 3, 2016
Messages
58
Hello Everyone,

I dabble in VBA a bit and have searched and created a bunch of things and implemented it into a working sheet.
The sheet works as expected and everything is great, but the sheet is slow. I mainly think its because of the Worksheet_Change sub for the sheet, and since the sheet is password protected, it makes it difficult to make it work fast, at least with my limited knowledge of VBA.

This is a shared document so I try to keep things password protected to avoid the issue of anyone screwing anything up, so the password protection has to stay.

So since all the subs require to password protect and unprotect multiple times due to the Worksheet_Change sub which runs to customize the sheet as needed depending on the options being selected, it ends up bogging things down.

Also, The reason why I reference "ThisWorkbook" as much as I have is because we work with a ton of different workbooks so I need to ensure that whenever a script is running in the background, its actually running it against this spreadsheet as opposed to another spreadsheet which the user may end up activating while the script is running, and in turn giving a VBA error.

I know the code isnt pretty, so any help to make it work better would be greatly appreciated.

VBA Code: 
Private Sub Worksheet_Change(ByVal target As Range)
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled

    If IsEmpty(Range("C5").Value) Then
        Me.Unprotect "qwerty123"
        ThisWorkbook.Worksheets("Sheet1").Range("C6:E8,C10:E10,C13:E18,B21:E21,C23:E24,C26:E26,C28:E28,L13:N18,R19,B18,O18").Locked = True
        ThisWorkbook.Worksheets("Sheet1").Range("C6:E8,C10:E10,C13:E18,B21:E21,C23:E24,C26:E26,C28:E28,B18").Interior.Color = RGB(192, 192, 192)
        Me.Protect "qwerty123"
        
        ElseIf ThisWorkbook.Worksheets("Sheet1").Range("C5").Value = "NEW" Then
            Me.Unprotect "qwerty123"
            ThisWorkbook.Worksheets("Sheet1").Range("D21:E21,C26:E26,C28:E28,C24:E24,L18:N18").Locked = True
            ThisWorkbook.Worksheets("Sheet1").Range("D21:E21,C26:E26,C28:E28,C24:E24").Interior.Color = RGB(192, 192, 192)
            ThisWorkbook.Worksheets("Sheet1").Range("C6:E8,C10:D10,E10,L13:N17,B21:C21,C23:E23,R19,L17:N17,O18").Locked = False
            ThisWorkbook.Worksheets("Sheet1").Range("C6:E8,C10:D10,E10,C13:E17,B21:C21,C23:E23,B18").Interior.Color = RGB(255, 255, 204)
            Me.Protect "qwerty123"
            If ThisWorkbook.Worksheets("Sheet1").Range("O18").Value = True Then
            Me.Unprotect "qwerty123"
            ThisWorkbook.Worksheets("Sheet1").Range("B18,L18:N18").Locked = False
            ThisWorkbook.Worksheets("Sheet1").Range("B18:E18").Interior.Color = RGB(255, 255, 204)
            Me.Protect "qwerty123"
            Else
            Me.Unprotect "qwerty123"
            ThisWorkbook.Worksheets("Sheet1").Range("B18:E18").Interior.Color = RGB(192, 192, 192)
            Me.Protect "qwerty123"
            End If
            
        ElseIf ThisWorkbook.Worksheets("Sheet1").Range("C5").Value = "UPDATE" Then
            Me.Unprotect "qwerty123"
            ThisWorkbook.Worksheets("Sheet1").Range("C6:E6,C10:D10,E10,B21:E21,C23:E23,C28:E28,B18,O18").Locked = True
            ThisWorkbook.Worksheets("Sheet1").Range("C6:E6,C10:D10,E10,B21:E21,C23:E23,C28:E28,B18").Interior.Color = RGB(192, 192, 192)
            ThisWorkbook.Worksheets("Sheet1").Range("C7:E8,C24:E24,C26:E26,R19,L13:N17").Locked = False
            ThisWorkbook.Worksheets("Sheet1").Range("C7:E8,C13:E18,C24:E24,C26:E26").Interior.Color = RGB(255, 255, 204)
            Me.Protect "qwerty123"
            If ThisWorkbook.Worksheets("Sheet1").Range("O18").Value = True Then
            Me.Unprotect "qwerty123"
            ThisWorkbook.Worksheets("Sheet1").Range("L18:N18").Locked = False
            ThisWorkbook.Worksheets("Sheet1").Range("C18:E18").Interior.Color = RGB(255, 255, 204)
            Me.Protect "qwerty123"
            Else
            Me.Unprotect "qwerty123"
            ThisWorkbook.Worksheets("Sheet1").Range("B18:E18").Interior.Color = RGB(192, 192, 192)
            Me.Protect "qwerty123"
            End If
            
        ElseIf ThisWorkbook.Worksheets("Sheet1").Range("C5").Value = "CLOSED" Then
            Me.Unprotect "qwerty123"
            ThisWorkbook.Worksheets("Sheet1").Range("C6:E8,C10:D10,E10,C13:E18,B21:C21,C23:E23,C26:E26,L13:N18,B18,O18").Locked = True
            ThisWorkbook.Worksheets("Sheet1").Range("C6:E8,C10:D10,E10,C13:E18,B21:C21,C23:E23,C26:E26,B18").Interior.Color = RGB(192, 192, 192)
            ThisWorkbook.Worksheets("Sheet1").Range("D21:E21,C24:E24,C28:E28,R19").Locked = False
            ThisWorkbook.Worksheets("Sheet1").Range("D21:E21,C24:E24,C28:E28").Interior.Color = RGB(255, 255, 204)
            Me.Protect "qwerty123"
            
    Else
         Me.Unprotect "qwerty123"
         ThisWorkbook.Worksheets("Sheet1").Range("C6:E8,C10:D10,E10,C13:E18,B21:E21,C23:E24,C26:E26,C28:E28,L13:N18,O18,R19").Locked = True
         ThisWorkbook.Worksheets("Sheet1").Range("C6:E8,C10:D10,E10,C13:E18,B21:E21,C23:E24,C26:E26,C28:E28").Interior.Color = RGB(192, 192, 192)
         Me.Protect "qwerty123"

    End If
    
    If ThisWorkbook.Worksheets("Sheet1").Range("C5") = "NEW" Then
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button1").Visible = ([C6] <> "" And [C7] <> "" And [C8] <> "" And [C10] <> "" And [E10] <> "" And [O13] <> "NO ISSUE" And [B21] <> "" And [C21] <> "" And [C23] <> "")
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button2").Visible = True
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button3").Visible = False
    Shapes("Button4").Visible = True
    ElseIf ThisWorkbook.Worksheets("Sheet1").Range("C5") = "UPDATE" Then
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button1").Visible = ([C6] <> "" And [C7] <> "" And [C8] <> "" And [C10] <> "" And [E10] <> "" And [B21] <> "" And [C21] <> "" And [O13] <> "NO ISSUE" And [C23] <> "" And [C23] <> "" And [C26] <> "")
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button2").Visible = True
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button3").Visible = False
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button4").Visible = True
    ElseIf ThisWorkbook.Worksheets("Sheet1").Range("C5") = "CLOSED" Then
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button1").Visible = ([C6] <> "" And [C7] <> "" And [C8] <> "" And [C10] <> "" And [E10] <> "" And [B21] <> "" And [C21] <> "" And [D21] <> "" And [E21] <> "" And [C23] <> "" And [C24] <> "" And [C28] <> "")
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button3").Visible = ([C6] <> "" And [C7] <> "" And [C8] <> "" And [C10] <> "" And [E10] <> "" And [B21] <> "" And [C21] <> "" And [D21] <> "" And [E21] <> "" And [C23] <> "" And [C24] <> "" And [C28] <> "")
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button2").Visible = True
    Else
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button1").Visible = False
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button3").Visible = False
    ThisWorkbook.Worksheets("Sheet1").Shapes("Button4").Visible = True
    End If
       
    
    
Application.EnableCancelKey = xlInterupt
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------------------
Private Sub Other_Click()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled

If ThisWorkbook.Worksheets("Sheet1").Range("C5").Value = "NEW" Then
    If Range("O18").Value = True Then
    Me.Unprotect "qwerty123"
    ThisWorkbook.Worksheets("Sheet1").Range("B18,L18:N18").Locked = False
    ThisWorkbook.Worksheets("Sheet1").Range("B18,C18:E18").Interior.Color = RGB(255, 255, 204)
    ThisWorkbook.Worksheets("Sheet1").Range("B18").Value = "      "
    Me.Protect "qwerty123"
    Else
    Me.Unprotect "qwerty123"
    ThisWorkbook.Worksheets("Sheet1").Range("B18,L18:N18").Locked = True
    ThisWorkbook.Worksheets("Sheet1").Range("B18,C18:E18").Interior.Color = RGB(192, 192, 192)
    ThisWorkbook.Worksheets("Sheet1").Range("B18").Value = "      Other"
    Me.Protect "qwerty123"
    End If
    End If

Application.EnableCancelKey = xlInterupt
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------------------
Private Sub SentLabel()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False

Dim answer As Long
    
If Not IsEmpty(Range("C3").Value) Then
    answer = MsgBox("Proceed?" & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Range("C3"), vbQuestion + vbYesNo, "Box1")
    If answer = vbYes Then
        Call Sent
    Else
    End If
End If

Application.EnableEvents = True
Application.EnableCancelKey = xlInterupt
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------------------
Private Sub Sent()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = True

    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("C5").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -37)
    Me.Unprotect "qwerty123"
    Application.EnableEvents = False
    Worksheets("Sheet1").Range("C6").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -36)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("C7").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -35)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("C8").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -34)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("C10").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -33)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("E10").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -32)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("B18").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -31)
    Me.Unprotect "qwerty123"
    Application.EnableEvents = True
    Worksheets("Sheet1").Range("O18").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -30)
    Application.EnableEvents = False
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("L13").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -29)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("L14").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -28)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("L15").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -27)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("L16").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -26)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("L17").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -25)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("L18").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -24)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("M13").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -23)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("M14").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -22)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("M15").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -21)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("M16").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -20)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("M17").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -19)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("M18").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -18)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("N13").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -17)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("N14").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -16)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("N15").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -15)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("N16").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -14)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("N17").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -13)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("N18").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -12)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("B21").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -11)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("C21").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -10)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("D21").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -9)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("E21").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -8)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("C23").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -7)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("C24").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -6)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("C26").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -5)
    Me.Unprotect "qwerty123"
    Worksheets("Sheet1").Range("C28").Value = Worksheets("Sheet1Log").Columns(38).Find(Worksheets("Sheet1").Range("C3").Value).Offset(, -4)
    Me.Protect "qwerty123"

Application.EnableEvents = True
Application.EnableCancelKey = xlInterupt
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------------------
Private Sub SendButton()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False

Call Sheet1Action

Application.EnableEvents = True
Application.EnableCancelKey = xlInterupt
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------------------
Private Sub ResetButton()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = True

Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("C5").Value = "NEW"
Application.EnableEvents = False
'Me.Protect "qwerty123"
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("C3:E3,C6:E8,C10:E10,B21:E21,C23:E24,C26:E26,C28:E28").ClearContents
'Me.Protect "qwerty123"
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("L13:N18").Locked = False
'Me.Protect "qwerty123"
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("L13:N18").Value = "TRUE"
'Me.Protect "qwerty123"
Me.Unprotect "qwerty123"
Application.EnableEvents = True
ThisWorkbook.Worksheets("Sheet1").Range("O18").Value = "FALSE"
Application.EnableEvents = False
'Me.Protect "qwerty123"
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("B18").Value = "      Other"
Me.Protect "qwerty123"
ActiveWindow.ScrollRow = 1
ThisWorkbook.Worksheets("Sheet1").Range("C5").Select

Application.EnableEvents = True
Application.EnableCancelKey = xlInterupt
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------------------
Private Sub CopyToSheet1Log()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False

ThisWorkbook.Worksheets("Sheet1Log").Unprotect "qwerty123"

Dim sh1Rng, sh1Val, I As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet1Log")
sh1Rng = Array("C5", "C6", "C7", "C8", "C10", "E10", "P18", "O18", "L13", "L14", "L15", "L16", "L17", "L18", "M13", "M14", "M15", "M16", "M17", "M18", "N13", "N14", "N15", "N16", "N17", "N18", "B21", "C21", "D21", "E21", "C23", "C24", "C26", "C28", "H21", "K1", "L1", "M1")
ReDim sh1Val(UBound(sh1Rng))
    For I = LBound(sh1Rng) To UBound(sh1Rng)
        sh1Val(I) = sh1.Range(sh1Rng(I)).Value
    Next I
sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, UBound(sh1Val) + 1) = sh1Val
ThisWorkbook.Worksheets("Sheet1Log").Columns(27).NumberFormat = "mm/dd/yyyy"
ThisWorkbook.Worksheets("Sheet1Log").Columns(28).NumberFormat = "hh:mm"
ThisWorkbook.Worksheets("Sheet1Log").Columns(29).NumberFormat = "mm/dd/yyyy"
ThisWorkbook.Worksheets("Sheet1Log").Columns(30).NumberFormat = "hh:mm"
ThisWorkbook.Worksheets("Sheet1Log").Columns(35).NumberFormat = "[hh]:mm;@"
ThisWorkbook.Worksheets("Sheet1Log").Columns(36).NumberFormat = "mm/dd/yyyy hh:mm"

ThisWorkbook.Worksheets("Sheet1Log").Protect "qwerty123"

Application.EnableEvents = True
Application.EnableCancelKey = xlInterupt
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------------------
Private Sub Sheet1Action()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False

Me.Unprotect "qwerty123"


Dim OO As Object
On Error Resume Next
Set OO = GetObject(, "Outlook.Application")
On Error GoTo 0
If OO Is Nothing Then
ans = MsgBox("Outlook is not currently open. Would you like to open Outlook now?     If yes, Outlook will open and you will have to click on the SEND button again.", vbYesNo)
If ans = vbYes Then Shell ("Outlook")
If ans = vbNo Then Exit Sub
Else

ThisWorkbook.Worksheets("Sheet1").Range("A" & ThisWorkbook.Worksheets("Sheet1").Rows.Count).End(xlUp).Offset(0).Range("K1").Value = Format(Now(), "MM/DD/YYYY hh:mm:ss")
ThisWorkbook.Worksheets("UserList").Activate
Call Worksheets("UserList").ProcessUserList

    Dim NewEmail As MailItem
    Dim PathFileName As String
    
    'start of email address merge/selection
    Dim usrlist As Variant
    Dim I As Long
    For I = 0 To ThisWorkbook.Worksheets("UserList").Range("L" & Rows.Count).End(xlUp).Row Step 400
    usrlist = ThisWorkbook.Worksheets("UserList").Range("L2").Offset(I).Resize(400)
    'end of email address merge/selection
    
  PathFileName = Environ("SystemDrive") & "\Temp\EmailTemplate.oft"
  Set NewEmail = CreateItemFromTemplate(PathFileName)
  

  With NewEmail

    .Subject = ThisWorkbook.Worksheets("Sheet1").Range("H1").Value
    
    .HTMLBody = Replace(.HTMLBody, "#SUBJECT", ThisWorkbook.Worksheets("Sheet1").Range("H6").Value)
    .HTMLBody = Replace(.HTMLBody, "#TODAY", ThisWorkbook.Worksheets("Sheet1").Range("H3").Value)
    .HTMLBody = Replace(.HTMLBody, "#OTHER", ThisWorkbook.Worksheets("Sheet1").Range("H18").Value)
    
    BodyWithoutSignature = .HTMLBody
    .SentOnBehalfOfName = "dummy@dummy.com"
    .DeferredDeliveryTime = DateAdd("n", 3, Now)
    .ReplyUserList.Add "dummy@dummy.com"

    .To = "dummy@dummy.com"
    .BCC = Join(Application.Transpose(usrlist), ";")
    .Display
    .HTMLBody = BodyWithoutSignature
    Dim SaveAs As String

    
  End With
  Next
  
  ThisWorkbook.Worksheets("Sheet1").Activate
  Call SaveToPDF
  ThisWorkbook.Worksheets("Sheet1").Activate
  Call RecLog
  ThisWorkbook.Worksheets("Sheet1").Activate
  Call CopyToSheet1Log
  ThisWorkbook.Worksheets("Sheet1").Activate
  ActiveWindow.ScrollRow = 1
  ThisWorkbook.Worksheets("Sheet1").Range("C5").Select
  
  End If

Me.Protect "qwerty123"

Application.EnableEvents = True
Application.EnableCancelKey = xlInterupt
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------------------
Private Sub SaveToPDF()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False

ThisWorkbook.Unprotect "qwerty123"
ThisWorkbook.Worksheets("PDFTemp").Visible = True

'Create and assign Vars
Dim saveLocation As String
Dim ws As Worksheet
'Dim rng As Range

saveLocation = ThisWorkbook.Worksheets("Vars").Range("B11").Value & ThisWorkbook.Worksheets("Sheet1").Range("P1") & ".pdf"
Set ws = ThisWorkbook.Worksheets("PDFTemp")
'Set rng = ws.Range("T35:Y75")

'Save a range as PDF
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation

Worksheets("PDFTemp").Visible = False
ThisWorkbook.Protect "qwerty123"

Application.EnableEvents = True
Application.EnableCancelKey = xlInterupt
Application.ScreenUpdating = True
End Sub
Private Function WorkbookIsOpen(WorkbookName As String) As Boolean
On Error Resume Next
WorkbookIsOpen = Workbooks(WorkbookName).Name = WorkbookName
End Function
'-----------------------------------------------------------------------------
Private Sub RecLog()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False

Me.Unprotect "qwerty123"
    
ThisWorkbook.Worksheets("Sheet1").Range("H31").Value = ThisWorkbook.Worksheets("Sheet1").Range("K1")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("I31").Value = ThisWorkbook.Worksheets("Sheet1").Range("C5")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("J31").Value = ThisWorkbook.Worksheets("Sheet1").Range("C10")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("K31").Value = ThisWorkbook.Worksheets("Sheet1").Range("E10")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("L31").Value = ThisWorkbook.Worksheets("Sheet1").Range("C6")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("M31").Value = ThisWorkbook.Worksheets("Sheet1").Range("K8")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("N31").Value = ThisWorkbook.Worksheets("Sheet1").Range("K7")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("O31").Value = ThisWorkbook.Worksheets("Sheet1").Range("O12")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("P31").Value = ThisWorkbook.Worksheets("Sheet1").Range("B21")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("Q31").Value = ThisWorkbook.Worksheets("Sheet1").Range("C21")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("R31").Value = ThisWorkbook.Worksheets("Sheet1").Range("C23")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("S31").Value = ThisWorkbook.Worksheets("Sheet1").Range("S29")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("T31").Value = ThisWorkbook.Worksheets("Sheet1").Range("T29")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("U31").Value = ThisWorkbook.Worksheets("Sheet1").Range("U29")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("V31").Value = ThisWorkbook.Worksheets("Sheet1").Range("V29")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("W31").Value = ThisWorkbook.Worksheets("Sheet1").Range("W29")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("X31").Value = ThisWorkbook.Worksheets("Sheet1").Range("X29")
Me.Unprotect "qwerty123"
ThisWorkbook.Worksheets("Sheet1").Range("Y31").Value = ThisWorkbook.Worksheets("Sheet1").Range("O1")
Me.Unprotect "qwerty123"
ActiveCell.Hyperlinks.Add Anchor:=ThisWorkbook.Worksheets("Sheet1").Range("Z31"), Address:=ThisWorkbook.Worksheets("Vars").Range("B11").Value & ThisWorkbook.Worksheets("Sheet1").Range("P1") & ".pdf", SubAddress:="", ScreenTip:="", TextToDisplay:="Click Here"
Me.Unprotect "qwerty123"

If WorkbookIsOpen("ExternalLog.xlsx") Then
    Workbooks("ExternalLog.xlsx").Close True
    With Workbooks.Open(ThisWorkbook.Worksheets("Vars").Range("B3").Value)
    Workbooks("ExternalLog.xlsx").Worksheets(Email1).Unprotect "qwerty123"
    ThisWorkbook.Worksheets("Sheet1").Range("H31:Z31").Copy
    Workbooks("ExternalLog.xlsx").Worksheets(Email1).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
    Workbooks("ExternalLog.xlsx").Worksheets(Email1).Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlPasteValues
    Workbooks("ExternalLog.xlsx").Worksheets(Email1).Protect "qwerty123"
    Workbooks("ExternalLog.xlsx").Close True
    DoEvents
    End With
Else
    With Workbooks.Open(ThisWorkbook.Worksheets("Vars").Range("B3").Value)
    Workbooks("ExternalLog.xlsx").Worksheets(Email1).Unprotect "qwerty123"
    ThisWorkbook.Worksheets("Sheet1").Range("H31:Z31").Copy
    Workbooks("ExternalLog.xlsx").Worksheets(Email1).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
    Workbooks("ExternalLog.xlsx").Worksheets(Email1).Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlPasteValues
    Workbooks("ExternalLog.xlsx").Worksheets(Email1).Protect "qwerty123"
    Workbooks("ExternalLog.xlsx").Close True
    DoEvents
    End With

End If
Me.Protect "qwerty123"

Application.EnableEvents = True
Application.EnableCancelKey = xlInterupt
Application.ScreenUpdating = True
End Sub
'-----------------------------------------------------------------------------
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
I notice that you only make changes to the visibility and formatting when either C5 or O18 changes, so if detect when these change and only exceute the macro when one of these change most of hte time it will be very fast. So add just this one line to the top of you macro:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If ((Intersect(Target, Range("c5:c5")) Is Nothing)) And ((Intersect(Target, Range("O18:O18")) Is Nothing)) Then Exit Sub   ' add this line
Note: I am assuming that C5 and O18 are not changed by a formula
 
Upvote 0
offthelip said:
I notice that you only make changes to the visibility and formatting when either C5 or O18 changes, so if detect when these change and only exceute the macro when one of these change most of hte time it will be very fast. So add just this one line to the top of you macro:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If ((Intersect(Target, Range("c5:c5")) Is Nothing)) And ((Intersect(Target, Range("O18:O18")) Is Nothing)) Then Exit Sub   ' add this line
Note: I am assuming that C5 and O18 are not changed by a formula
Click to expand...
Thank you! I will give this a try later today.

As far as C5 and O18 changing via formula, I am not 100% sure if this matters, but when I run the reset sub to clear the form, it will change O18 back to FALSE, as well as C5 to NEW.

Also, all fields change once I run the SENT sub which recalls the previously sent details and inputs them into the form, hence changing the values of everything thats on the sheet. The drop down to select which message to repopulate is based off of what gets written to the log sheet.

Hope this makes sense.

I was just hoping to clean the whole thing up and optimize things to make it work smoother because I feel like all of it is all over the place. Does it work, Yes, but if I can clean it up for easier modification later, that'd be great too :) haha
 
Upvote 0
So I tried the above, and it appears that the Buttons shapes that I have are NOT working.
The way it should work is that once all the required fields are filled out, the SEND button enables, otherwise it remains disabled. After adding the line you recommended, it does NOT work now.
 
Upvote 0
elitef said:
So I tried the above, and it appears that the Buttons shapes that I have are NOT working.
The way it should work is that once all the required fields are filled out, the SEND button enables, otherwise it remains disabled. After adding the line you recommended, it does NOT work now.
Click to expand...
So I've moved the Shapes If section above the line that you mentioned, and that appears to now work for the buttons.
Anything else I can do to clean this baby up to make it work better, faster, and be cleaner when editing? :)
 
Upvote 0
You could use conditional fromatting to do the color changes instead of the VBA.
 
Upvote 0
Your sent macro looks very very slow because it is doing the same search multiple times and is accessing the workbvook many times which will make it slow. I have rewritten it to use a varaint array but I am not sure I have fully understood what you are doing so try this, it might give you some ideas about how to improve your code:
VBA Code: 
Sub Sent()
Application.ScreenUpdating = False
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = True

With Worksheets("Sheet1Log")
 lastrow = .Cells(Rows.Count, "AL").End(xlUp).Row  ' find last row of column 38
 inarr = .Range(.Cells(1, 1), .Cells(lastrow, 38)) ' load all of Sheet1log into a variant array in memory
End With
 Search4 = Worksheets("Sheet1").Range("C3")
 Me.Unprotect "qwerty123"
 For i = 1 To lastrow
   If Search4 = inarr(i, 38) Then
    ' we have found the row
    Worksheets("Sheet1").Range("C6").Value = inarr(i, 38 - 36)
    Worksheets("Sheet1").Range("C7").Value = inarr(i, 38 - 35)
    Worksheets("Sheet1").Range("C8").Value = inarr(i, 38 - 34)
    Worksheets("Sheet1").Range("C10").Value = inarr(i, 38 - 33)
    Worksheets("Sheet1").Range("E10").Value = inarr(i, 38 - 32)
    Worksheets("Sheet1").Range("B18").Value = inarr(i, 38 - 31)
    Application.EnableEvents = True
    Worksheets("Sheet1").Range("O18").Value = inarr(i, 38 - 30)
    Application.EnableEvents = False
    Worksheets("Sheet1").Range("L13").Value = inarr(i, 38 - 29)
    Worksheets("Sheet1").Range("L14").Value = inarr(i, 38 - 28)
    Worksheets("Sheet1").Range("L15").Value = inarr(i, 38 - 27)
    Worksheets("Sheet1").Range("L16").Value = inarr(i, 38 - 26)
    Worksheets("Sheet1").Range("L17").Value = inarr(i, 38 - 25)
    Worksheets("Sheet1").Range("L18").Value = inarr(i, 38 - 24)
    Worksheets("Sheet1").Range("M13").Value = inarr(i, 38 - 23)
    Worksheets("Sheet1").Range("M14").Value = inarr(i, 38 - 22)
    Worksheets("Sheet1").Range("M15").Value = inarr(i, 38 - 21)
    Worksheets("Sheet1").Range("M16").Value = inarr(i, 38 - 20)
    Worksheets("Sheet1").Range("M17").Value = inarr(i, 38 - 19)
    Worksheets("Sheet1").Range("M18").Value = inarr(i, 38 - 18)
    Worksheets("Sheet1").Range("N13").Value = inarr(i, 38 - 17)
    Worksheets("Sheet1").Range("N14").Value = inarr(i, 38 - 16)
    Worksheets("Sheet1").Range("N15").Value = inarr(i, 38 - 15)
    Worksheets("Sheet1").Range("N16").Value = inarr(i, 38 - 14)
    Worksheets("Sheet1").Range("N17").Value = inarr(i, 38 - 13)
    Worksheets("Sheet1").Range("N18").Value = inarr(i, 38 - 12)
    Worksheets("Sheet1").Range("B21").Value = inarr(i, 38 - 11)
    Worksheets("Sheet1").Range("C21").Value = inarr(i, 38 - 10)
    Worksheets("Sheet1").Range("D21").Value = inarr(i, 38 - 9)
    Worksheets("Sheet1").Range("E21").Value = inarr(i, 38 - 8)
    Worksheets("Sheet1").Range("C23").Value = inarr(i, 38 - 7)
    Worksheets("Sheet1").Range("C24").Value = inarr(i, 38 - 6)
    Worksheets("Sheet1").Range("C26").Value = inarr(i, 38 - 5)
    Worksheets("Sheet1").Range("C28").Value = inarr(i, 38 - 4)
    Exit For
    End If
  Next i
    Me.Protect "qwerty123"


End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Solved
help with current date VBA code
Replies
4
Views
256
Alex Blakenburg
A
Rob_010101
  • Solved
Add message box
Replies
4
Views
469
Joe4
Joe4
B
  • Solved
VBA Help - Same Function needed for multiple sheets
Replies
2
Views
585
birdman15
B
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
584
RoryA
RoryA
I
  • Solved
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
512
ItalianPlatinum
I

Forum statistics

Threads
1,223,882
Messages
6,175,165
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top