Need code to run across an Array of sheets

[mduff]

Hi,

I have this code that I put together it's not very pretty but it gets the job done

Now what I need to do is have this run across specific sheets in a workbook (not all of them) the sheets will always have the same name so what I can;t figure out how to do is run on sheet1 sheet2 etc. I was thinking of using an array of sheet names and loop but honestly this is bit beyond my skills

Any help would be appreciated

Sub Fix_Sheet()


' Cleans Raw data sheet
'


'
    Columns("E:E").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Day"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=TEXT(RC[-2],""ddd"")"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E5000")
    Range("E2:E5000").Select
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "Interval"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=(RC[1]/24)+(RC[2]/1440)"
    Range("F2").Select
    Selection.AutoFill Destination:=Range("F2:F5000")
    Range("F2:F5000").Select
    Columns("F:F").Select
    Selection.NumberFormat = "[$-409]h:mm AM/PM;@"
    
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "lookup"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]&RC[2]"
    Range("D2").Select
    Selection.AutoFill Destination:=Range("D2:D5000")
    Range("D2:D5000").Select
    
    
     Range("A1").Select
    ActiveCell.FormulaR1C1 = "WeekNum"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=WEEKNUM(RC[+2])"
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A5000")
    Range("A2:A5000").Select
    Columns("A:A").Select
    Selection.NumberFormat = "#,##0"
    Columns("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    ActiveSheet.UsedRange.Select


End Sub

[Paul_Hossler]

Demo of a sub to loop the worksheets and to call your code depending on the sheet name (I just guesses)

I also cleaned your sub a little since you usually don't need to .Select first, and I wanted everything to be within the "With / End With" (the reason for the .Range() etc.)

Sub LoopTheWorksheets()
    Dim wsCheck As Worksheet
    
    For Each wsCheck In ActiveWorkbook.Worksheets
        If wsCheck.Name Like "DoThis*" Then
            If Not wsCheck.ProtectContents = False Then
                Call Fix_Sheet(wsCheck)
            End If
        End If
    Next
End Sub
 

Sub Fix_Sheet(ws As Worksheet)
    
    With ws
        .Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("E1").FormulaR1C1 = "Day"
        .Range("E2").FormulaR1C1 = "=TEXT(RC[-2],""ddd"")"
        .Range("E2").AutoFill Destination:=Range("E2:E5000")
    
        .Range("C1").FormulaR1C1 = "Date"
    
        .Columns("F:F").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        .Range("F1").FormulaR1C1 = "Interval"
        .Range("F2").FormulaR1C1 = "=(RC[1]/24)+(RC[2]/1440)"
        .Range("F2").AutoFill Destination:=Range("F2:F5000")
        .Columns("F:F").NumberFormat = "[$-409]h:mm AM/PM;@"
     
        .Range("D1").FormulaR1C1 = "lookup"
        .Range("D2").FormulaR1C1 = "=RC[-1]&RC[2]"
        .Range("D2").AutoFill Destination:=Range("D2:D5000")
     
     
        .Range("A1").FormulaR1C1 = "WeekNum"
        .Range("A2").FormulaR1C1 = "=WEEKNUM(RC[+2])"
        .Range("A2").AutoFill Destination:=Range("A2:A5000")
        .Columns("A:A").NumberFormat = "#,##0"
    
        .Columns("G:G").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
    
End Sub

No test, but hopefully it will move you forward


Paul