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...:eek:
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

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
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

C
  • Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
85
myall_blues
myall_blues
willow1985
  • Solved
Find first blank cell in column A in a Table - Runtime error 91
Replies
4
Views
135
willow1985
willow1985
C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
98
CapRavOr
C
Dazzawm
  • Question
Change Recorded Range To Used Range.
2
Replies
12
Views
393
Dazzawm
Dazzawm
C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
250
Coco1
C

Forum statistics

Threads
1,215,516
Messages
6,125,285
Members
449,218
Latest member
Excel Master

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