Help with simplification of a macro.

Z

zoog25

Active Member
Joined
Nov 21, 2011
Messages
418
Hello all,

I know this is something but I was wondering if anyone could help me simplify the following macro. I'm still new to writing macros and the following code adds a new job entry into a job list. I used recording and other steps to write it and it work, but it feels a little long and I know it can be shortened but I don't know where to start, so if you can please help me that would be great.

Code: 
Sub New_Job()
Dim Job, PM, ProjectName, Contractor As String
Application.ScreenUpdating = False
Job = InputBox("Input Job #")
PM = InputBox("Input PM initials")
ProjectName = InputBox("Input Project Name")
Contractor = InputBox("Input Contractor's Name")
    Sheets("Current Job List").Range("A7:A10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
    Sheets("Current Job List").Range("B7:B10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
    Sheets("Current Job List").Range("C7:C10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
    Sheets("Current Job List").Range("D7:D10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
    Sheets("Current Job List").Range("E7:E10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
    Sheets("Current Job List").Range("F7:F10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
        Sheets("Current Job List").Range("D7:D10").Select
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Sheets("Current Job List").Range("C7:C10").Select
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Sheets("Current Job List").Range("B7:B10").Select
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Sheets("Current Job List").Range("A7:A10").Select
            Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Sheets("Current Job List").Range("A7").Value = Job
    Range("A7:A10").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 90
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 12
    End With
    Sheets("Current Job List").Range("B7").Value = PM
    Range("B7:B10").Select
    Selection.Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 9
    End With
    Sheets("Current Job List").Range("C7").Value = ProjectName
    Sheets("Current Job List").Range("D7").Value = Contractor
    Sheets("Current Job List").Range("E7").Value = "Office contact:"
    Sheets("Current Job List").Range("E8").Value = "Jobsite contact:"
    Sheets("Current Job List").Range("E9").Value = "Jobsite phone:"
    Sheets("Current Job List").Range("E10").Value = "Jobsite fax:"
    With Sheets("Current Job List").Range("E4:E7").Font
        .Name = "Arial"
        .Size = 8
        .Bold = False
    End With
    
Application.ScreenUpdating = True
End Sub

Thank you if you can help.
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
Small little tips in shortening VBA code:
1) Look if you're using any Activesheet or Selection methods in the code. If you do, replace them by explicitly stating them!
2) Look if there is a common object you're working with.. You can either use object definition or With statement to make the code look cleaner. I would recommend using object definition because I've heard that With statement slows your code down... ALOT.
3) Just like a novel or a book, indentation and new lines are important (especially in VBA for technical reasons). Use them to split up a large program into several parts which serve different functions.

So, here is the very roughly shortened code:
Code: 
Sub New_Job()
Dim Job, PM, ProjectName, Contractor As String, s As Sheet
Application.ScreenUpdating = False
Job = InputBox("Input Job #")
PM = InputBox("Input PM initials")
ProjectName = InputBox("Input Project Name")
Contractor = InputBox("Input Contractor's Name")

'Using object declaration
Set s = Sheets("Current Job List")
    s.Range("A7:A10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
    s.Range("B7:B10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
    s.Range("C7:C10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
    s.Range("D7:D10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
    s.Range("E7:E10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
    s.Range("F7:F10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
        s.Range("D7:D10").Borders(xlInsideHorizontal).LineStyle = xlNone
        s.Range("C7:C10").Borders(xlInsideHorizontal).LineStyle = xlNone
        s.Range("B7:B10").Borders(xlInsideHorizontal).LineStyle = xlNone
        s.Range("A7:A10").Borders(xlInsideHorizontal).LineStyle = xlNone
    s.Range("A7").Value = Job
    Range("A7:A10").Select
    Selection.Merge
    'I wasn't comfortable with working with merged cells so I left it as selected, change it if you want.
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 90
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 12
    End With

    s.Range("B7").Value = PM
    Range("B7:B10").Merge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Bold"
        .Size = 9
    End With

    s.Range("C7").Value = ProjectName
    s.Range("D7").Value = Contractor
    s.Range("E7").Value = "Office contact:"
    s.Range("E8").Value = "Jobsite contact:"
    s.Range("E9").Value = "Jobsite phone:"
    s.Range("E10").Value = "Jobsite fax:"
    With s.Range("E4:E7").Font
        .Name = "Arial"
        .Size = 8
        .Bold = False
    End With
    
Application.ScreenUpdating = True
End Sub
 
Upvote 0
I think this might work. I may be missing an End With though

Code: 
Sub New_Job()Dim Job, PM, ProjectName, Contractor As String
Application.ScreenUpdating = False
Job = InputBox("Input Job #")
PM = InputBox("Input PM initials")
ProjectName = InputBox("Input Project Name")
Contractor = InputBox("Input Contractor's Name")
    With Sheets("Current Job List")
        .Range("A7:F10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
        .Range("A7:F10").Borders(xlInsideHorizontal).LineStyle = xlNone
        .Range("A7").Value = Job
        With .Range("A7:A10")
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 90
            With .Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 12
            End With
        End With
        Sheets("Current Job List").Range("B7").Value = PM
        With .Range("B7:B10")
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            With .Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 9
            End With
        End With
        .Range("C7").Value = ProjectName
        .Range("D7").Value = Contractor
        .Range("E7").Value = "Office contact:"
        .Range("E8").Value = "Jobsite contact:"
        .Range("E9").Value = "Jobsite phone:"
        .Range("E10").Value = "Jobsite fax:"
    With .Range("E4:E7").Font
        .Name = "Arial"
        .Size = 8
        .Bold = False
    End With
    
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Maybe ...

Code: 
Sub New_Job()
    With Worksheets("Current Job List")
        .Range("A7:F10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
        .Range("A7:D10").Borders(xlInsideHorizontal).LineStyle = xlNone
        
        With .Range("A7:A10")
            .Cells(1).Value = InputBox("Job #?")
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 90
            .Font.Name = "Arial"
            .Font.FontStyle = "Bold"
            .Font.Size = 12
        End With
        With .Range("B7:B10")
            .Cells(1).Value = InputBox("PM initials?")
            .Merge
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .Font.Name = "Arial"
            .Font.FontStyle = "Bold"
            .Font.Size = 9
        End With
        
        .Range("C7:D7").Value = Array(InputBox("Project Name?"), InputBox("Contractor's Name?"))
        
        With .Range("E4:E7").Font
            .Name = "Arial"
            .Size = 8
            .Bold = False
        End With
        
        .Range("E7:E10").Value = WorksheetFunction.Transpose(Array("Office contact:", "Jobsite contact:", "Jobsite phone:", "Jobsite fax:"))
    End With
End Sub
 
Upvote 0
Untested, but I think this will work...

Code: 
Sub New_Job()
    Dim Job As String, PM As String, ProjectName As String, Contractor As String
    Application.ScreenUpdating = False
    Job = InputBox("Input Job #")
    PM = InputBox("Input PM initials")
    ProjectName = InputBox("Input Project Name")
    Contractor = InputBox("Input Contractor's Name")
    With Sheets("Current Job List")
        .Range("A7:F10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromBelow
        .Range("A7:D10").Borders(xlInsideHorizontal).LineStyle = xlNone
        .Range("A7").Value = Job
        .Range("B7").Value = PM
        With .Range("E4:E7").Font
            .Name = "Arial"
            .Size = 8
            .Bold = False
        End With
    End With
    With Range("A7:A10")
        .Merge
        .Orientation = 90
        .Font.Size = 12
    End With
    With Range("B7:B10")
        .Merge
        .Orientation = 0
        .Font.Size = 9
    End With
    With Range("A7:B10")
        .Merge
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        With .Font
            .Name = "Arial"
            .FontStyle = "Bold"
        End With
    End With
    Range("C7:E7").Value = Array("ProjectName", "Contractor", "Office contact:")
    Range("E8:E10").Value = Application.Transpose(Array("Jobsite contact:", "Jobsite phone:", "Jobsite fax:"))
    Application.ScreenUpdating = True
End Sub
'
Note particularly what I did with the Dim statement. Your original Dim statement only declared the Contractor variable as a String, the rest were declared as Variants. In VB, all variables must be Dim'med as to their data type individually.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Loop through each file in folder and perform an action
Replies
0
Views
189
Monsieur Roo
M
M
  • Question
Hiding lay-out with a macro
Replies
2
Views
105
MIBO
M
A
  • Solved
what am doing wrong?
Replies
5
Views
299
ageordieinneed
A
J
  • Question
VBA Code to Add Rows is slowing down
Replies
5
Views
188
JayB0730
J
4
  • Question
VBA - Dynamic Cell Shifting
Replies
4
Views
448
4EverStudent
4

Forum statistics

Threads
1,203,487
Messages
6,055,713
Members
444,810
Latest member
ExcelMuch

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