Skip code if no cells are visible in VBA

[andrewb90]

Hey there!

I have this code that copies all visible cells in a cell range, however if there are no visible cells, i get an error. Is there a best solution that would prevent an error in the even of no visible cells?

Sub Sa_PM()'prep
    Sheets("Print").Range("D82:D109").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostSa").Select
    Range("C81").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Sheets("Print").Select
Sheets("Print").Range("V82:X109").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostSa").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("RostSa").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RostSa").Sort.SortFields.Add Key:=Range("D81:D108"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("RostSa").Sort.SortFields.Add Key:=Range("C81:C108"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RostSa").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("RostSa").Select
    Range("C110").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Sheets("Print").Select
Sheets("Print").Range("V111:X124").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostSa").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("RostSa").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RostSa").Sort.SortFields.Add Key:=Range("D110:D123"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("RostSa").Sort.SortFields.Add Key:=Range("C110:C123"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RostSa").Sort
        .SetRange Range("C110:F123")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
        


End Sub

 

[dchaney]

What line of code is tossing the error?

 

[andrewb90]

Any line with:

[COLOR=#333333].SpecialCells(xlCellTypeVisible).Copy[/COLOR]

Most of the time there will be visible cells within the selected ranges, but occasionally the conditions of my sheet will make no cells visible, and I get errors when that happens

 

[Michael M]

Maybe

Sub Sa_PM() 'prep
On Error Resume Next
Sheets("Print").Range("D82:D109").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostSa").Range("C81").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
    Sheets("Print").Range("V82:X109").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostSa").Range("D81").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
    Worksheets("RostSa").Sort.SortFields.Clear
    Worksheets("RostSa").Sort.SortFields.Add Key:=Range("D81:D108"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Worksheets("RostSa").Sort.SortFields.Add Key:=Range("C81:C108"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RostSa").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("RostSa").Range("C110").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=False
Sheets("Print").Range("V111:X124").SpecialCells(xlCellTypeVisible).Copy
    Sheets("RostSa").Range("D110").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
    Worksheets("RostSa").Sort.SortFields.Clear
    Worksheets("RostSa").Sort.SortFields.Add Key:=Range("D110:D123"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    Worksheets("RostSa").Sort.SortFields.Add Key:=Range("C110:C123"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RostSa").Sort
        .SetRange Range("C110:F123")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 end sub

 

[andrewb90]

Awesome! thank you