Tidy Code

M

Molden

Active Member
Joined
Jun 20, 2006
Messages
373
Has anyone got any suggestions on how to compact this code. all this code is doubling the size of the report

Application.ScreenUpdating = False
Dim lRow As Long
On Error Resume Next
lRow = Application.WorksheetFunction.Match(Sheets("Progress Check").Range("N11"), Sheets("Progress Check Data").Range("A11:A65536"), 0)
On Error GoTo 0
If lRow > 0 Then MsgBox "Duplicate Record - Job No. Already Exsists", vbCritical, "Duplicate Record": Exit Sub
With Sheet3
If Range("I11") = "" Then
MsgBox "Enter A Visit Date", vbCritical, "Visit Date Blank"
Range("I11").Select
Exit Sub
End If
If Range("N11") = "" Then
MsgBox "Enter A Job Number", vbCritical, "Job Number Blank"
Exit Sub
Range("N11").Select
End If
If Range("I13") = "" Then
MsgBox "Enter A Address", vbCritical, "Address Blank"
Exit Sub
Range("I13").Select
End If
If Range("I15") = "" Then
MsgBox "Enter Managers Name", vbCritical, "Manager Blank"
Exit Sub
Range("I15").Select
End If
If Range("N15") = "" Then
MsgBox "Enter A Postcode", vbCritical, "Postcode Blank"
Exit Sub
Range("N15").Select
End If
If .ComboBox1 = "" Then
MsgBox "Enter Installer", vbCritical, "Installer Blank"
Exit Sub
.ComboBox1.Select
End If
If .ComboBox2 = "" Then
MsgBox "Enter Overall Opinion", vbCritical, "Overall Opinion Blank"
Exit Sub
.ComboBox2.Select
End If
End With
Sheet4.Select
Rows("11:11").Select
Selection.Insert Shift:=xlDown
Range("A11").Select
Call Progress_check_DBS
With Sheet3
If .CheckBox1 = True Then
Sheet4.Range("I11") = .CheckBox1
End If
If .CheckBox2 = True Then
Sheet4.Range("K11") = .CheckBox2
End If
If .CheckBox3 = True Then
Sheet4.Range("M11") = .CheckBox3
End If
If .CheckBox4 = True Then
Sheet4.Range("O11") = .CheckBox4
End If
If .CheckBox5 = True Then
Sheet4.Range("Q11") = .CheckBox5
End If
If .CheckBox6 = True Then
Sheet4.Range("S11") = .CheckBox6
End If
If .CheckBox7 = True Then
Sheet4.Range("U11") = .CheckBox7
End If
If .CheckBox8 = True Then
Sheet4.Range("W11") = .CheckBox8
End If
If .CheckBox9 = True Then
Sheet4.Range("Y11") = .CheckBox9
End If
If .CheckBox10 = True Then
Sheet4.Range("AA11") = .CheckBox10
End If
If .CheckBox11 = True Then
Sheet4.Range("AC11") = .CheckBox11
End If
If .CheckBox12 = True Then
Sheet4.Range("AE11") = .CheckBox12
End If
If .CheckBox13 = True Then
Sheet4.Range("AG11") = .CheckBox13
End If
If .CheckBox14 = True Then
Sheet4.Range("AI11") = .CheckBox14
End If
If .CheckBox15 = True Then
Sheet4.Range("AK11") = .CheckBox15
End If
Sheet4.Range("AM11") = .ComboBox2
.CheckBox1 = False
.CheckBox2 = False
.CheckBox3 = False
.CheckBox4 = False
.CheckBox5 = False
.CheckBox6 = False
.CheckBox7 = False
.CheckBox8 = False
.CheckBox9 = False
.CheckBox10 = False
.CheckBox11 = False
.CheckBox12 = False
.CheckBox13 = False
.CheckBox14 = False
.CheckBox15 = False
.ComboBox1 = ""
.ComboBox2 = ""
Sheet3.Range("I11") = ""
Sheet3.Range("N11") = ""
Sheet3.Range("I13") = ""
Sheet3.Range("I15") = ""
Sheet3.Range("N15") = ""
Sheet3.Range("G35:G63") = ""
Sheet3.Range("H5") = ""
Sheet3.Range("C71") = ""
End With
Sheet3.Select
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
TIP1
you have this on top
Code: 
Application.ScreenUpdating = False
but when the code takes the way of "Exit Sub", the screenupdating can cause problems

therefore put a
Code: 
Goto skip
instead of Exit Sub
just before End Sub
put
Code: 
skip:
Application.ScreenUpdating = True

TIP2
indent and "block" your code for better readin and maintenance
post using the CODE-button

this is the enhanced code
Code: 
Sub t()
Dim lRow As Long
Dim i As Integer

On Error Resume Next
lRow = Application.WorksheetFunction.Match(Sheets("Progress Check").Range("N11"), Sheets("Progress Check Data").Range("A11:A65536"), 0)
On Error GoTo 0

If lRow > 0 Then MsgBox "Duplicate Record - Job No. Already Exsists", vbCritical, "Duplicate Record": GoTo skip

    With Sheet3
        If Range("I11") = "" Then
        MsgBox "Enter A Visit Date", vbCritical, "Visit Date Blank"
        Range("I11").Select
        GoTo skip
        End If
        
        If Range("N11") = "" Then
        MsgBox "Enter A Job Number", vbCritical, "Job Number Blank"
        GoTo skip
        Range("N11").Select
        End If
        
        If Range("I13") = "" Then
        MsgBox "Enter A Address", vbCritical, "Address Blank"
        GoTo skip
        Range("I13").Select
        End If
        
        If Range("I15") = "" Then
        MsgBox "Enter Managers Name", vbCritical, "Manager Blank"
        GoTo skip
        Range("I15").Select
        End If
        
        If Range("N15") = "" Then
        MsgBox "Enter A Postcode", vbCritical, "Postcode Blank"
        GoTo skip
        Range("N15").Select
        End If
        
        If .ComboBox1 = "" Then
        MsgBox "Enter Installer", vbCritical, "Installer Blank"
        GoTo skip
        .ComboBox1.Select
        End If
        
        If .ComboBox2 = "" Then
        MsgBox "Enter Overall Opinion", vbCritical, "Overall Opinion Blank"
        GoTo skip
        .ComboBox2.Select
        End If
        
    End With
    
sheet4.Select
Rows("11:11").Select
Selection.Insert Shift:=xlDown
Range("A11").Select

Call Progress_check_DBS

    For i = 1 To 15
    If .Shapes("CheckBox" & i).OLEFormat.Object.Object = True Then _
    sheet4.Cells(11, 9 + (i - 1) * 2) = True
    .Shapes("CheckBox" & i).OLEFormat.Object.Object = False
    Next i

    .ComboBox1 = ""
    .ComboBox2 = ""

    Sheet3.Range("I11,N11,I13,I15,N15,G35:G63,H5,C71") = ""
    End With
Sheet3.Select

skip:
Application.ScreenUpdating = True

End Sub
I'll try to come with a solution for the first part too

kind regards,
Erik
 
Upvote 0
OK
name your cells which must be checked one by one
Visit_Date
Job_Number
etcetera
(it would be better NOT to name a cell "Address", so find something like "location" or ...)
as you can see the names have underscores instead of spaces - which are not accepted
the code will revert them back to spaces to display
Code: 
cellName = Application.Substitute(c.Value, "_", " ")
the code for that part would then be
Code: 
        Dim c As Range
        Dim cellName As String
        'I11,N11,I13,I15,N15 must all be named separately
        'I11,N11,I13,I15,N15 can be named as a whole: example name "rangetocheck"
        'then use For Each c In Range("rangetocheck")
        For Each c In Range("I11,N11,I13,I15,N15")
        If c = "" Then
        cellName = Application.Substitute(c.Value, "_", " ")
        MsgBox "Enter A " & cellName, vbCritical, cellName & " Blank"
        c.Select
        GoTo skip
        End If
My previous code has an End With in wrong place
corrected this
(I cannot test easily without the workbook
entire code would then be
Code: 
Sub t()
Dim lRow As Long
Dim i As Integer
Dim c As Range
Dim cellName As String

On Error Resume Next
lRow = Application.WorksheetFunction.Match(Sheets("Progress Check").Range("N11"), Sheets("Progress Check Data").Range("A11:A65536"), 0)
On Error GoTo 0

If lRow > 0 Then MsgBox "Duplicate Record - Job No. Already Exsists", vbCritical, "Duplicate Record": GoTo skip

    With Sheet3
        'I11,N11,I13,I15,N15 must all be named separately
        'I11,N11,I13,I15,N15 can be named as a whole: example name "rangetocheck"
        'then use For Each c In Range("rangetocheck")
        For Each c In Range("I11,N11,I13,I15,N15")
            If c = "" Then
            cellName = Application.Substitute(c.Value, "_", " ")
            MsgBox "Enter A " & cellName, vbCritical, cellName & " Blank"
            c.Select
            GoTo skip
            End If
        Next c
        
        If .ComboBox1 = "" Then
        MsgBox "Enter Installer", vbCritical, "Installer Blank"
        GoTo skip
        .ComboBox1.Select
        End If
        
        If .ComboBox2 = "" Then
        MsgBox "Enter Overall Opinion", vbCritical, "Overall Opinion Blank"
        GoTo skip
        .ComboBox2.Select
        End If
        
sheet4.Select
Rows("11:11").Select
Selection.Insert Shift:=xlDown
Range("A11").Select

'Call Progress_check_DBS

        For i = 1 To 15
        If .Shapes("CheckBox" & i).OLEFormat.Object.Object = True Then _
        sheet4.Cells(11, 9 + (i - 1) * 2) = True
        .Shapes("CheckBox" & i).OLEFormat.Object.Object = False
        Next i

    .ComboBox1 = ""
    .ComboBox2 = ""

    .Range("I11,N11,I13,I15,N15,G35:G63,H5,C71") = ""
    .Select
    End With


skip:
Application.ScreenUpdating = True

End Sub
you will need some time to test to my sense ...
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
Can't get folder to create on desktop. When debugging it shows no errors.
2 3
Replies
24
Views
530
jolivanes
jolivanes
C
  • Solved
Workbook Won't Close
Replies
4
Views
139
6StringJazzer
6StringJazzer
I
  • Solved
RTE 9 Subscript out of range
Replies
4
Views
87
Peter_SSs
Peter_SSs
K
  • Question Question
Select the Name in the Data Validation list on a cell value then the same name run the sub macro
Replies
9
Views
476
kpmsivaprakasam2003
K
I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
233
ipbr21054
I

Forum statistics

Threads
1,225,768
Messages
6,186,924
Members
453,387
Latest member
uzairkhan

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