Loop Macro

[moni_tm]

Hello,

Please can you help. I would like to loop the following macro through worksheets which are labeled 1 through 31

 Range("A6:A25,C6:C25,C27").Select
    Range("C27").Activate
    ActiveWindow.SmallScroll Down:=21
    Range("A6:A25,C6:C25,C27,A32:A51,C32:C51,C53").Select
    Range("C53").Activate
    ActiveWindow.SmallScroll Down:=27
    Range("A6:A25,C6:C25,C27,A32:A51,C32:C51,C53,A58:A77,C58:C77,C79,E6:E77,G6:H77").Select
    Range("G6").Activate
    Selection.ClearContents

can anyone help?

Thank you

Tom

 

[MrKowz]

Can you please describe what you're trying to accomplish with the macro? To my understanding, you're clearing the contents from A6:A25,C6:C25,C27,A32:A51,C32:C51,C53,A58:A77,C58:C77,C79,E6:E77,G6:H77. Is this correct? Do you want to perform the same exact thing on every worksheet in your workbook, or only select worksheets? You mention worksheets labelled 1 - 31. Are they literally named "1", "2", "3", ..., "29", "30", "31"?

 

[moni_tm]

Hello,

Sorry, yes i would like to loop the macro only through worksheets labeled 1 2 3 4 .... to 31 to perform the same task of clearing those select cells.

Tom

 

[MrKowz]

Give this a shot:

Public Sub clearrangecontents()
Dim ws      As Worksheet

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

For Each ws In ActiveWorkbook.Worksheets
    Select Case ws.Name
        Case 1 To 31
            ws.Range("A6:A25,C6:C25,C27,A32:A51,C32:C51,C53,A58:A77,C58:C77,C79,E6:E77,G6:H77").ClearContents
        Case Else
            'do nothing
    End Select
Next ws

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

 

[moni_tm]

Thank you for this, unfortunately it doesn't clear the contents out of the required cells..

Tom

 

[wideboydixon]

Small change:

Public Sub clearrangecontents()

Dim ws As Worksheet
Dim wsValue As Long

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

For Each ws In ActiveWorkbook.Worksheets
    If InStr(",1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,", "," & ws.Name & ",") > 0 Then
        ws.Range("A6:A25,C6:C25,C27,A32:A51,C32:C51,C53,A58:A77,C58:C77,C79,E6:E77,G6:H77").ClearContents
    End If
Next ws

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

WBD