PDA

View Full Version : Need code to run across an Array of sheets



mduff
12-10-2013, 08:53 AM
Hi,

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

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
12-10-2013, 09:17 AM
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