Need to shorten my code

andrewb90

andrewb90

Well-known Member
Joined
Dec 16, 2009
Messages
1,077
Hello all,

I am slowly getting better at VBA, what I need to improve on more is making things shorter instead of just copying the same things over and over again. I was hoping to post my very long code and see if anybody could assist me in shortening it so that I can write more (perhaps, elegant?) code in the future.

Code: 
Sub M_FOH()'days
    Sheets("Print").Range("D6:D23").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Sheets("Print").Select
[COLOR=#ff0000]Sheets("Print").Range("G6:I23")[/COLOR].SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("D5").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    'nights
    Sheets("Print").Range("D25:D42").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("C24").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Sheets("Print").Select
Sheets("Print").Range("G25:I42").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("D24").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
        
Rows("5:41").Hidden = False
    For r = 5 To 41
        If r <> 4 Then
            If Range("C" & r).Value = "" Then Rows(r).Hidden = True
        End If
    Next r
        
        
    Range("C5:F41").Select
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Add Key:=Range("D5:D41"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Add Key:=Range("C5:C41"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RostM").Sort
        .SetRange Range("C5:F41")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        


End Sub


Sub M_BOH()
'days
    Sheets("Print").Range("D44:D61").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("C43").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Sheets("Print").Select
Sheets("Print").Range("G44:I61").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("D43").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    'nights
    Sheets("Print").Range("D63:D80").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("C62").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Sheets("Print").Select
Sheets("Print").Range("G63:I80").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("D62").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
        
        
Rows("43:79").Hidden = False 'lower number by 1 to cover nights label
    For r = 43 To 79
        If r <> 4 Then
            If Range("C" & r).Value = "" Then Rows(r).Hidden = True
        End If
    Next r
        
     Range("C43:F79").Select
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Add Key:=Range("D43:D79"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Add Key:=Range("C43:C79"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RostM").Sort
        .SetRange Range("C43:F79")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


End Sub


Sub M_PM()
'prep
    Sheets("Print").Range("D82:D109").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("C81").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Sheets("Print").Select
Sheets("Print").Range("G82:I109").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("D81").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
        
    Rows("81:108").Hidden = False
    For r = 81 To 108
        If r <> 4 Then
            If Range("C" & r).Value = "" Then Rows(r).Hidden = True
        End If
    Next r
        
     Range("C81:F108").Select
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Add Key:=Range("D81:D108"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Add Key:=Range("C81:C108"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RostM").Sort
        .SetRange Range("C81:F108")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    'mgr
    Sheets("Print").Range("D111:D124").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("C110").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Sheets("Print").Select
Sheets("Print").Range("G111:I124").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("D110").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
        
Rows("110:123").Hidden = False
    For r = 110 To 123
        If r <> 4 Then
            If Range("C" & r).Value = "" Then Rows(r).Hidden = True
        End If
    Next r
        
    Range("C110:F123").Select
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Add Key:=Range("D110:D123"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("RostM").Sort.SortFields.Add Key:=Range("C110:C123"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RostM").Sort
        .SetRange Range("C110:F123")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        


End Sub

To make things generally more complicated, This code is repeated 6 more times...:eeek:
The sheet: RostM is replaced by
RostTu, RostW, RostTh, RostF, RostSa, RostSu. All of the other values are the same as the sheets are identically formatted.

The only other difference is the cell range for the sheet: "Print" (shown red) that indicated columns G:I changes with each set of code. The code posted here has all G:I ranges with various rows. The RostTu set of codes will use J:L
Then the next codes will use:
M:O, P:R, S:U, V:X, Y:AA, respectively.

Ok, I hope I haven't made this too crazy or complicated for anybody...
 
Last edited:

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
you can shorten your code somewhat and speed it up, avoid selects where not necessary

example
'By-passes the Clipboard

Sheet1.Range("A1:A200").Copy Destination:=Sheet2.Range("B1")
so
Code: 
 Sheets("Print").Range("D6:D23").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostM").Select
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
maybe adjusted, I can't test this, but this might work (or not)
Sheets("Print").Range("D6:D23").SpecialCells(xlCellTypeVisible).Copy Destination:= Sheets("RostM").Range("C5").Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=True, Transpose:=False


the other thing that may help is using a global variable
declare the variable(s) i.e roster Monday and then a range
when you get to the code you need to repeat
assign the variable
call the sub that has all the repeating data and use the global variable, when the sub completes it will return
redeclare the variable with the next value and call the same sub, repeat until all done

Code: 
Sub Test()

Dim RosterDay
Dim RosterRngA
Dim RosterRngB


RosterDay = "RostM"
RosterRngA = "G"
RosterRngB = "I"

Call RosterPlotter

RosterDay = "RostTu"
RosterRngA = "J"
RosterRngB = "L"

Call RosterPlotter
End Sub

Sub RosterPlotter()
'Sheets("Print").Range("G6:I23").SpecialCells(xlCellTypeVisible).Copy
Sheets("Print").Range("RosterRngA & 6: & RosterRngB & 23").SpecialCells(xlCellTypeVisible).Copy
End Sub

I'm sure someone has better ways, they always do
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
244
willow1985
willow1985
K
  • Question Question
Increasing row before the macro runs again
Replies
1
Views
185
kbk
K
brent3162
  • Solved
VBA help with increasing row before macro runs again.
Replies
3
Views
343
jolivanes
jolivanes
E
  • Solved
A little VBA/Macro code adjustment
Replies
3
Views
262
rollis13
rollis13
N
  • Question Question
Adding to an existing MACRO
Replies
2
Views
98
Northern NY Design
N

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

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