Code clean up.

pg1987

New Member
Joined
Oct 14, 2013
Messages
3
Hi All,

I'm relatively new to VBA, and one thing I'm not good at is VBA housekeeping.

I have tried my best on the below, but I also think there is some duplication.

Would somebody be kind enough to clean up the following code and let me know if it can be cleaned and some tips on cleaning it aswell?

There is a massive amount of duplication in my cases, I imagine using strings would have been more appropriate, but I didn't realise this until after the project. It is something I will be looking to do anyway.

Also, the .activate makes the script relatively slow - any alternative that I can use? Looking forward to your response, and many thanks in advance.

Code:
Private Sub ComboBox2_Click()
 
Application.ScreenUpdating = False
 
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim rRange As Range, rngToCopy As Range
    Dim lRow As Long
    Dim SearchString As String
    SearchString = ComboBox2.Text
 
 
    Worksheets("New Non-Compliance").Activate
    Range("i18:l40").ClearContents
   
    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("2013")
 
    With ws
        '~~> Get the Last Row
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
 
        '~~> Set your range for autofilter
        Set rRange = .Range("b1:i" & lRow)
 
        '~~> Remove any filters
        .AutoFilterMode = False
 
        '~~> Filter, copy visible rows to temp sheet
        With rRange
            .AutoFilter Field:=2, Criteria1:=SearchString
 
            Set rngToCopy = .SpecialCells(xlCellTypeVisible).EntireRow
 
            Set wsTemp = Sheets.Add
 
            rngToCopy.Copy
            wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
        End With
 
        '~~> Remove any filters
        .AutoFilterMode = False
        .Range("A1:M1").AutoFilter
       
    End With
   
    '~~> Re arrange columns in Temp sheet
    With wsTemp
        .Range("A:c,f:f,h:l").Delete Shift:=xlToLeft
 
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row
 
        Set rngToCopy = .Range("A1:D" & lRow)
 
        Debug.Print rngToCopy.Address
 
        '~~> Copy the range to clipboard
        rngToCopy.Copy
    End With
   
    Worksheets("New Non-Compliance").Activate
    ActiveSheet.Range("i18").Select
    ActiveSheet.Range("i18").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
 
End Sub
Private Sub CommandButton1_Click()
    'Set up variables
    Dim j As Integer
 
    New_Non_Conformance_Input
 
End Sub
Private Sub New_Non_Conformance_Input()
   
    Dim j As Integer
    'Go to Yearly sheet and add details
    Worksheets("2013").Activate
    ActiveSheet.Range("A2").Select
    If ActiveCell.Value <> "x" Then
        ActiveSheet.Rows(2).Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        ActiveSheet.Range("A2:g2").ClearContents
    End If
    ActiveCell.Value = ComboBox6.Text
    ActiveCell.Offset(0, 1) = ComboBox4.Text
    ActiveCell.Offset(0, 2) = ComboBox2.Text
    ActiveCell.Offset(0, 3) = Sheets("New Non-Compliance").Range("E8")
    ActiveCell.Offset(0, 3) = Calendar2.Value
    ActiveCell.Offset(0, 4) = ComboBox1.Text
    If ActiveCell.Offset(0, 4).Value = "Temp Swipe Card" Then
        ActiveCell.Offset(0, 5) = ComboBox5.Text
    Else
        ActiveCell.Offset(0, 5) = "N/A"
    End If
    ActiveCell.Offset(0, 6) = ComboBox3.Text
 
    'Do borders
    For j = 0 To 12
        ActiveCell.Offset(0, j).BorderAround ColorIndex:=1, Weight:=xlThin
    Next j
   
    Frank_Click
      
    Application.ScreenUpdating = True
  
    End Sub
 
Private Sub Frank_Click()
   
    Application.ScreenUpdating = False
    
 
    Dim ws As Worksheet, wsTemp As Worksheet
    Dim rRange As Range, rngToCopy As Range
    Dim lRow As Long
    Dim emDate, emName, emOffence, emAction, emFName, emSig1, emSig2, emOriginalName As String
    Dim emSubject As String
    Dim cpy As New DataObject
    Dim emFBDate As Date
    Dim emDDDate As Date
 
    emOriginalName = Worksheets("2013").Range("C2")
    emDate = Worksheets("2013").Range("D2")
    emName = Worksheets("2013").Range("T2")
    emFName = Worksheets("2013").Range("U2")
    emOffence = Worksheets("2013").Range("E2")
    emAction = Worksheets("2013").Range("G2")
    emSubject = "SMB - " & emName & " - " & emOffence & " - " & emAction & " required" & " - " & emDate
    emSig1 = Worksheets("2013").Range("V2")
    emSig2 = "Many Thanks," & vbNewLine & vbNewLine & emSig1
 
 
'Find Feedback Date
  Worksheets("2013").Activate
       
    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("2013")
 
    With ws
        '~~> Get the Last Row
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
 
        '~~> Set your range for autofilter
        Set rRange = .Range("A1:M1" & lRow)
 
        '~~> Remove any filters
        .AutoFilterMode = False
 
        '~~> Filter, copy visible rows to temp sheet
        With rRange
                                 
 
            .AutoFilter
            .AutoFilter Field:=3, Criteria1:=emOriginalName
            .AutoFilter Field:=5, Criteria1:=emOffence
            .AutoFilter Field:=7, Criteria1:="Feedback"
 
        End With
       
 
            Set rngToCopy = ws.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
 
 
            Set wsTemp = Sheets.Add
 
            rngToCopy.Copy
           
            wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
        '~~> Remove any filters
       
        .AutoFilterMode = False
        .Range("A1:M1").AutoFilter
       
        End With
       
    With wsTemp
       
                  
        .Range("A:C,E:M").Delete Shift:=xlToLeft
       
       
    End With
   
emFBDate = wsTemp.Range("A2").Value
 
    'Delete sheet and remove alerts
    Application.DisplayAlerts = False
    wsTemp.Delete
    'alerts back on after delete
    Application.DisplayAlerts = True
   
   
   
' Find DD Date
 
  Worksheets("2013").Activate
       
    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("2013")
 
    With ws
        '~~> Get the Last Row
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
 
        '~~> Set your range for autofilter
        Set rRange = .Range("A1:M1" & lRow)
 
        '~~> Remove any filters
        .AutoFilterMode = False
 
        '~~> Filter, copy visible rows to temp sheet
        With rRange
                                 
 
            .AutoFilter
            .AutoFilter Field:=3, Criteria1:=emOriginalName
            .AutoFilter Field:=5, Criteria1:=emOffence
            .AutoFilter Field:=7, Criteria1:="Documented Discussion"
 
        End With
       
 
            Set rngToCopy = ws.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
 
 
            Set wsTemp = Sheets.Add
 
            rngToCopy.Copy
           
            wsTemp.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
        '~~> Remove any filters
       
        .AutoFilterMode = False
        .Range("A1:M1").AutoFilter
       
        End With
       
    With wsTemp
       
                  
        .Range("A:C,E:M").Delete Shift:=xlToLeft
       
       
    End With
   
emDDDate = wsTemp.Range("A2").Value
 
    'Delete sheet and remove alerts
    Application.DisplayAlerts = False
    wsTemp.Delete
    'alerts back on after delete
    Application.DisplayAlerts = True
 
  'Cases - identify email needed
Select Case emOffence
'-------------------------------------
'CONFI DATA EMAIL SCRIPT/CODE
'-------------------------------------
 
    Case "Confidential Data"
   
        Select Case emAction
       
            Case "Feedback"
         
                cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi, " & vbNewLine & vbNewLine _
                & "During a Security Walk on the " & emDate & ", unattended confidential data" _
                & " was found on " & emFName & "'s desk (please see attached file). Leaving" _
                & " confidential information unattended is contrary to both ISO27001 standards" _
                & " and Workplace policy. " & vbNewLine & vbNewLine & "Please provide feedback" _
                & " ASAP stressing the importance of keeping confidential data secure at all" _
                & " times, please note that recurrence within 6 months may lead to further" _
                & " action being required." & vbNewLine & vbNewLine & emSig2
 
               cpy.PutInClipboard
 
 
       
        
            Case "Documented Discussion"
     
                cpy.SetText emSubject & vbNewLine & "Hi," & vbNewLine & vbNewLine _
                & "During today's security walk (" & emDate & "), unattended confidential" _
                & " data (see attached file) was found on " & emFName & "'s desk. As you " _
                & "are aware, leaving confidential information unattended is contrary to" _
                & " both ISO27001 standards and Workplace policy." & vbNewLine & vbNewLine _
                & "This is the second occasion within 6 months that unattended confidential" _
                & " data has been found relating to " & emFName & ", the first occasion was" _
                & " on the " & emFBDate & ", therefore a documented discussion will be required." _
                & vbNewLine & vbNewLine & "Please can you complete the attached documented" _
                & " discussion form and send a completed copy to SAAT within 48 hours." _
                & " Please also be aware that a recurrence within 6 months may lead to" _
                & " further action being required." & vbNewLine & vbNewLine & emSig2
 
                cpy.PutInClipboard
     
     
       
         
            Case "Referal to Disciplinary"
   
                cpy.SetText emSubject & vbNewLine & "Hi," & vbNewLine & vbNewLine _
                & "During today's security walk " & emDate & ", unattended confidential data" _
                & "(see attached file) was found on " & emFName & "'s desk. Leaving confidential" _
                & " information unattended is contrary to both ISO27001 standards and Workplace" _
                & " policy." & vbNewLine & vbNewLine & "This is the second occasion within 6" _
                & " months of a Documented Discussion for" & emFName _
                & " (who received a Documented Discussion for Confi Data on  " & emDDDate & "), therefore" _
                & " an Investigation will be required." & vbNewLine & vbNewLine & "Please can" _
                & " you schedule an investigation within the next 24 hours to ensure the meeting" _
                & " takes place within 48 hours. If there is any reason you are unable to do this" _
                & " please let us know at your earliest convenience and advise SAAT of the outcome" _
                & "when it has taken place." & vbNewLine & vbNewLine & "If you require any further" _
                & " information or support from SAAT, please do not hesitate to get in touch." _
                & vbNewLine & vbNewLine & emSig2
     
                cpy.PutInClipboard
     
 
        End Select
   
    '-------------------------------------
    'Temp Card EMAIL SCRIPT/CODE
    '-------------------------------------
   
Case "Temp Swipe Card"
 
     
        Select Case emAction
        
            Case "Feedback"
             
                cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," & vbNewLine & vbNewLine _
                & emFName & " was issued with a temporary card on the " & emDate & "." _
                & " As you are aware, " & emOffence & "s are monitored by SAAT under ISO27001" _
                & " controls." & vbNewLine & vbNewLine & "Please provide feedback to " _
                & emFName & " reiterating the importance of complying with the ISO27001" _
                & " controls that are in place. Please be aware, recurrence within 6 months" _
                & " may result in further action being required." _
                & vbNewLine & vbNewLine & emSig2
 
                cpy.PutInClipboard
 
               'MsgBox "Temp Card Feedback email has been created and copied to clipboard"
 
            Case "Documented Discussion"
     
                cpy.SetText emSubject & vbNewLine & "Hi," & vbNewLine & vbNewLine _
                & emFName & " was issued with a temporary card on the " & emDate & "." _
                & " As you are aware, " & emOffence & "s are monitored by SAAT under ISO27001" _
                & " controls." & vbNewLine & vbNewLine & "This is the second occasion that" _
                & emFName & " has been issued with a temporary card within the previous" _
                & " 6 months (the first occasion was on the " & emFBDate & "), therefore a" _
                & " Documented Discussion will be required." & vbNewLine & vbNewLine _
                & "Please complete the attached Documented Discussion and return a signed" _
                & " copy to SAAT within 48 hours. If there will be delay in returning the" _
                & " completed Documented Discussion, please reply to this email outlining" _
                & " the reason and a date that we can expect to receive the signed copy." _
                & vbNewLine & vbNewLine & emSig2
 
                cpy.PutInClipboard
   
 
            Case "Referal to Disciplinary"
   
                cpy.SetText emSubject & vbNewLine & "Hi," & vbNewLine & vbNewLine _
                & emFName & " was issued with a temporary card on the " & emDate & "." _
                & " As you are aware, " & emOffence & "s are monitored by SAAT under ISO27001" _
                & "controls." & vbNewLine & vbNewLine & "A Documented Discussion was" _
                & " completed within the previous 6 months (This was requested on the  " & emDDDate & ")" _
                & " for " & emFName & " and" _
                & " therefore, an investigation will now be required." & vbNewLine & vbNewLine _
                & "Please arrange an investigation at your very earliest convenience and" _
                & " make SAAT aware of the outcome once completed." & vbNewLine & vbNewLine _
                & "For your evidence, the previous occasions when " & emFName & " was issued" _
                & " with a temporary card were on: <insert previous="" occasions="" here="">." _
                & vbNewLine & vbNewLine & "If you require any more information or support" _
                & " from SAAT, please do not hesitate to get in touch." _
                & vbNewLine & vbNewLine & emSig2
     
                cpy.PutInClipboard
     
        End Select
 
'-------------------------------------
'Unattended PC EMAIL SCRIPT/CODE
'-------------------------------------
 
Case "Unattended PC"
   
    Select Case emAction
         
        Case "Feedback"
       
          cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
          & vbNewLine & vbNewLine & "During today's security walk (" & emDate & "), " _
          & emFName & "'s PC was found unattended and unlocked. This is contrary to" _
          & " Workplace policy and ISO27001 standards." & vbNewLine & vbNewLine _
          & "Please provide feedback ASAP stressing the importance of keeping PCs" _
          & " locked whenever agents are away from their desks and that a recurrence" _
          & " within 6 months may lead to further action being required." _
          & vbNewLine & vbNewLine & emSig2
 
          cpy.PutInClipboard
 
 
        Case "Documented Discussion"
     
          cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
          & vbNewLine & vbNewLine & "During today's security walk (" & emDate & "), " _
          & emFName & "'s PC was found unattended and unlocked. This is contrary to" _
          & " Workplace policy and ISO27001 standards." & vbNewLine & vbNewLine _
          & "This is the second occurrence of an incident of this type for this agent in 6 months" _
          & " (feedback was requested for an unattended PC on " & emFBDate & ") and so is normally dealt with as" _
          & " a Documented Discussion" & "." & vbNewLine & vbNewLine & "Please can you" _
          & " complete the attached form and send a completed copy to SAAT within " _
          & " 48 hours. If there is a difficulty in meeting this deadline" _
          & " (eg for absence/sickness/holidays etc) just inform us of when you expect" _
          & " to complete this action. Please also remind the agent that a recurrence" _
          & " within 6 months may lead to further action being required." _
          & vbNewLine & vbNewLine & emSig2
 
          cpy.PutInClipboard
   
 
        Case "Referal to Disciplinary"
   
          cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
          & vbNewLine & vbNewLine & "During today's security walk (" & emDate & "), " _
          & emFName & "'s PC was found unattended and unlocked. This is contrary to" _
          & " Workplace policy and ISO27001 standards." & vbNewLine & vbNewLine _
          & "This is the second occasion within 6 months of a Documented Discussion for this agent" _
          & " (who received a Documented Discussion for an unattended PC on  " & emDDDate & "), therefore an" _
          & " Investigation will be required." & vbNewLine & vbNewLine _
          & " Please can you schedule an investigation meeting within the next 24 hours to ensure" _
          & " the meeting takes place within 48 hours. If there is any reason you are unable to do " _
          & " this please let us know at your earliest convenience and advise SAAT of the outcome " _
          & "when it has taken place." & vbNewLine & vbNewLine _
          & "If you require any further information or support from SAAT, please do not hesitate to get in touch." _
          & vbNewLine & vbNewLine & emSig2
 
     
          cpy.PutInClipboard
     
    End Select
 
'-------------------------------------
'Unattended Card EMAIL SCRIPT/CODE
'-------------------------------------
   
Case "Unattended Swipe Card"
   
    Select Case emAction
   
   
        Case "Feedback"
     
          cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
          & vbNewLine & vbNewLine & "During today's security walk (DATE), " _
          & emFName & "'s swipe card was found unattended. This is contrary to both" _
          & " Workplace Policy and ISO27001 standards." & vbNewLine & vbNewLine _
          & "Please provide feedback ASAP stressing the importance of keeping swipe" _
          & " cards secure and on your person at all times and that a recurrence within" _
          & " 6 months may lead to further action being required." _
          & vbNewLine & vbNewLine & emSig2
 
 
          cpy.PutInClipboard
 
 
 
        Case "Documented Discussion"
     
          cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
          & vbNewLine & vbNewLine & "During today's security walk (" & emDate & "), this agent's swipe card" _
          & " was found unattended. This is contrary to both Workplace Policy and" _
          & "ISO27001 standards." & vbNewLine & vbNewLine _
          & "This is the second occurrence of an incident of this type for " & emFName & " in" _
          & " 6 months (feedback was requested for an unattended swipe card on " & emFBDate & ")" _
          & " and so is normally dealt with as a documented discussion. I have therefore " _
          & "attached a prepared documented discussion form." & vbNewLine & vbNewLine _
          & "Please can you complete the attached form and send a completed copy to" _
          & " SAAT within 48 hours. If there is a difficulty in meeting this deadline" _
          & " (eg for absence/sickness/holidays etc) just inform us of when you expect" _
          & " to complete this action. Please also remind the agent that a recurrence within" _
          & " 6 months may lead to further action being required." _
          & vbNewLine & vbNewLine & emSig2
 
          cpy.PutInClipboard
      
      
        Case "Referal to Disciplinary"
   
          cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
          & vbNewLine & vbNewLine & " During today's security walk (" _
          & emDate & "), " & emFName & "'s swipe card was found unattended." _
          & "This is contrary to both Workplace Policy and ISO27001 standards." _
          & vbNewLine & vbNewLine & "This is the second occasion within 6" _
          & " months of a Documented Discussion for " & emFName & " (who " _
          & "received a Documented Discussion for an unattended swipe card" _
          & "on  " & emDDDate & "), therefore an Investigation will be required." & vbNewLine _
          & vbNewLine & "Please can you schedule an investigation meeting within" _
          & " the next 24 hours to ensure the meeting takes place within 48 hours." _
          & " If there is any reason you are unable to do this please let us know at" _
          & " your earliest convenience and advise SAAT of the outcome when" _
          & " it has taken place." _
          & vbNewLine & vbNewLine & emSig2
 
     
          cpy.PutInClipboard
     
      End Select
 
'-------------------------------------
'Mobile Phone EMAIL SCRIPT/CODE
'-------------------------------------
Case "Mobile Phone"
     
    Select Case emAction
 
        Case "Feedback"
       
           cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
           & "During this month's staff compliance audit, " & emFName _
           & "'s mobile phone was found to be switched on while on the unit. This is contrary to" _
           & " Workplace policy and ISO27001 standards." & vbNewLine & vbNewLine _
           & "Please provide feedback ASAP stressing the importance of ensuring" _
           & " mobile phones are switched off before entering the unit and that a recurrence" _
           & " within 6 months may lead to further action being required." _
           & vbNewLine & vbNewLine & emSig2
          
           cpy.PutInClipboard
 
          
         Case "Documented Discussion"
     
           cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
           & vbNewLine & vbNewLine & "During this month's staff compliance audit " _
           & emFName & " was found to have their mobile phone switched on while on the" _
           & " unit today (" & emDate & "). This is contrary to Workplace policy and ISO27001" _
           & " standards." & vbNewLine & vbNewLine & "This is the second occurrence of an" _
           & " incident of this type for this agent in 6 months (feedback was requested" _
           & " for mobile phone misuse on " & emFBDate & ") and so is normally dealt with as a" _
           & " documented discussion. I have therefore attached a prepared documented" _
           & " discussion form." & vbNewLine & vbNewLine & "Please can you complete the " _
           & " attached form and send a completed copy to SAAT within 48 hours. If there" _
           & " is a difficulty in meeting this deadline (eg for absence/sickness/holidays" _
           & " etc) just inform us of when you expect to complete this action." _
           & " Please also remind the agent that a recurrence within 6 months may" _
           & " lead to further action being required." _
           & vbNewLine & vbNewLine & emSig2
   
           cpy.PutInClipboard
   
            
        Case "Referal to Disciplinary"
   
           cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
           & vbNewLine & vbNewLine & "During a compliance audit with " & emFName & ", " _
           & " their Mobile Phone was found to be switched on. This is contrary to" _
           & " Workplace policy and ISO27001 standards." & vbNewLine & vbNewLine _
           & "This is the second occasion within 6 months of a Documented Discussion for this agent" _
           & " (who received a Documented Discussion for their mobile phone on the " & emDDDate & "), therefore an" _
           & " Investigation will be required." & vbNewLine & vbNewLine _
           & " Please can you schedule an investigation meeting within the next 24 hours to ensure" _
           & " the meeting takes place within 48 hours. If there is any reason you are unable to do " _
           & " this please let us know at your earliest convenience and also please advise SAAT of the outcome " _
           & "when it has taken place." & vbNewLine & vbNewLine _
           & "If you require any further information or support from SAAT, please do not hesitate to get in touch." _
           & vbNewLine & vbNewLine & emSig2
     
           cpy.PutInClipboard
 
    
    End Select
        
Case "Internet Misuse"
        
    Select Case emAction
   
        Case "Feedback"
           
            cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
            & vbNewLine & vbNewLine & "During Today 's security walk (" & emDate & ")," _
            & emFName & " was found using the internet for non business related purposes." _
            & " This is contrary to Workplace Policy and ISO27001 Controls. Please provide" _
            & " feedback stressing the importance of using the internet for business" _
            & " related purposes only." & vbNewLine & vbNewLine _
            & "Please be aware that a recurrence within 6 months may lead to further" _
            & " action being required." _
            & vbNewLine & vbNewLine & emSig2
                       
            cpy.PutInClipboard
           
                     
        Case "Documented Discussion"
       
            cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
            & vbNewLine & vbNewLine & "During Today 's security walk (" & emDate & ")," _
            & emFName & " was found using the internet for non business related purposes." _
            & " This is contrary to Workplace Policy and the ISO27001 controls." & vbNewLine _
            & vbNewLine & "This is the second occasion that " & emFName & " has been found" _
            & " to be using the internet for non business purpose within the previous 6" _
            & " months (the first occasion was on the " & emFBDate & " ), therefore a Documented Discussion will now be required." _
            & vbNewLine & vbNewLine & "Please complete the attached Documented Discussion" _
            & " and return a signed copy to SAAT within 48 hours. If you're unable to return" _
            & " a signed copy within this timescale, please reply to this email outlining" _
            & " the reason why and a date SAAT can expect to receive the document." _
            & vbNewLine & vbNewLine & emSig2
           
            cpy.PutInClipboard
           
                    
        Case "Referal to Disciplinary"
       
            cpy.SetText emSubject & vbNewLine & vbNewLine & "Hi," _
            & vbNewLine & vbNewLine & "During Today 's security walk (" & emDate & ")," _
            & emFName & " was found using the internet for non business related purposes." _
            & " This is contrary to Workplace Policy and the ISO27001 controls." & vbNewLine _
            & vbNewLine & "This is an additional occasion that " & emFName & " has been found" _
            & " to be using the internet for non business purpose within 6 months since they" _
            & " last had a Documented Discussion (Documented Discussion was issued on the " & emDDDate & ")" _
            & " therefore an Investigation will be required." & vbNewLine & vbNewLine _
            & "Please can you schedule an investigation meeting within the next 24 hours to ensure" _
            & " the meeting takes place within 48 hours. If there is any reason you are unable to do " _
            & " this please let us know at your earliest convenience and also please advise SAAT of the outcome " _
            & "when it has taken place." & vbNewLine & vbNewLine _
            & "If you require any further information or support from SAAT, please do not hesitate to get in touch." _
            & vbNewLine & vbNewLine & emSig2
           
            cpy.PutInClipboard
           
                    
        End Select
       
    End Select
  
  
' Activate front sheet.
ThisWorkbook.Sheets("New Non-Compliance").Activate
 
'Alert for confirmation
 
MsgBox "Your email for " & emName & " has been created." & vbNewLine & vbNewLine & "Please remember to include any" _
       & " attachments or evidence before sending the email for " & emOffence & "."
   
End Sub
</insert>
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Hello

There are quite a number of areas to improve on the existing code. A.o.

- all these long texts near the end of the code, that you put in the clipboard; I would store them in cells in a (hidden) worksheet. Or store them in text files. But not like that, buried in the VBA-code.
-
Code:
'Do borders
    For j = 0 To 12
        ActiveCell.Offset(0, j).BorderAround ColorIndex:=1, Weight:=xlThin
    Next j

Why not:

Code:
'Do borders
ActiveCell.Resize(, 12).BorderAround ColorIndex:=1, Weight:=xlThin

Avoid loops in VBA.

-
Code:
Dim emDate, emName, emOffence, emAction, emFName, emSig1, emSig2, emOriginalName As String
You need to repeat "As String" for each variable. Now, all but one variables are declared as Variant since you do not specify anything else. A classic mistake.

Code:
Set ws = ThisWorkbook.Sheets("2013")


With ws
   '...
End With

Why not:

Code:
With ThisWorkbook.Sheets("2013")
   '...
End With

and delete the variable ws.

Etc etc.
 
Upvote 0
Thank you, Wig.

I am an Excel nubbins, so things like this are things that I will adopt as I do more.

Thanks muchly for your input - I will make amendments as you have advised.

Paul
 
Upvote 0

Forum statistics

Threads
1,214,561
Messages
6,120,239
Members
448,951
Latest member
jennlynn

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