Help fixing and cleaning up code

[mightymorgs]

I know just enough about VBA to dig myself into a hole and I need some help getting out. I'm using the code below to format several worksheets within my workbook. I'm running into a few issues that I can't figure out how to solve.

1) The first part of the code runs on all of the targeted worksheets, as expected, but once it gets to the red text, it only runs on the active worksheet. I need the entire code to run on all of the targeted worksheets based on the control table on the control tab.

2) When the code gets to the part with the red text, it's adding all of the headed rows to the active worksheet so instead of having a head on each one, it's putting them all on one. What I'm trying to do is insert custom headers into the top row on each of the selected worksheets (based on the control table) without overwriting the data that's currently there.

I've attached a test document as well as a document that shows what I'd like the end state to look like.


Any help is appreciated!


Sub Delete()
Dim ws As Worksheet
Dim lastrow As Long
Dim i As Long
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
For Each ws In ThisWorkbook.Worksheets
If TryMatch(Lookup:=ws.Name, _
Lookin:=wsControl.ListObjects("tblTarget").DataBodyRange) Then
ws.Range("A:A,B:B,C:C,D:D,E:E,M:M,N:N,Q:Q,R:R").Delete
End If
If TryMatch(Lookup:=ws.Name, _
Lookin:=wsControl.ListObjects("tblTarget").DataBodyRange) Then
lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = lastrow To 1 Step -1
If TryMatch(Lookup:=ws.Cells(i, "A").Interior.Color, _
Lookin:=wsControl.ListObjects("tblColours").ListColumns(2).DataBodyRange) Then
ws.Rows(i).Delete
End If
Next i
End If
If TryMatch(Lookup:=ws.Name, _
Lookin:=wsControl.ListObjects("tblTarget").DataBodyRange) Then
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
End If
If TryMatch(Lookup:=ws.Name, _
Lookin:=wsControl.ListObjects("tblTarget").DataBodyRange) Then
Range("A1:J1").Value = Array("EE #", "mfg", "Serial #", "Initial Status", "Final Status", "Cost", "Description", "CSN", "CSN Description", "Category")
End If
Next ws
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

[Paul_Hossler]

If you don't use an explicit worksheet reference, Excel uses the active sheet

So Rows(1).Delete would work on Sheet1 the way you think IF Sheet1 is the Activesheet

If Sheet99 is the active sheet, then row 1 on Sheet99 would be deleted

So use Worksheets("Sheet2").Rows(1).Delete or ws.Rows(1).Delete

Marked some places, and made some suggestions (can't help myself :whistle: )




Option Explicit


Sub Delete()


Dim ws As Worksheet
Dim lastrow As Long
Dim i As Long

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

For Each ws In ThisWorkbook.Worksheets
'assume any dot-property (e.g. .Name, .Range, etc.) is to the current ws from the loop
With ws

Application.StatusBar = "Cleaning up Worksheet " & .Name

'easy way to avoid a lot or If/Thens
If Not TryMatch(Lookup:=.Name, Lookin:=wsControl.ListObjects("tblTarget").DataBodyRange) Then GoTo NextWS

'consolidated
.Range("A:E,M:N,Q:R").Delete

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

'I think the main problem was not having a 'dot' on many properties so the ActiveSheet (whatever it was) was always used
For i = lastrow To 1 Step -1
If TryMatch(Lookup:=.Cells(i, "A").Interior.Color, _
Lookin:=wsControl.ListObjects("tblColours").ListColumns(2).DataBodyRange) Then
.Rows(i).Delete ' no dot
End If
Next i

.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' no dot

'no dot
.Range("A1:J1").Value = Array("EE #", "mfg", "Serial #", "Initial Status", "Final Status", "Cost", "Description", "CSN", "CSN Description", "Category")

'easier for me to read
Call FormatWS(.Name)
End With

NextWS:
Next ws

With Application
.StatusBar = False
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With


End Sub


Private Function getColour(ByRef cell As Range) As Long
Dim intColor As Long
Dim RGB As String

getColour = cell.Interior.Color
End Function


Private Function TryMatch(ByVal Lookup As Variant, ByRef Lookin As Variant) As Boolean
Dim res As Long

On Error Resume Next
res = Application.Match(Lookup, Lookin, 0)
TryMatch = res <> 0
On Error GoTo 0
End Function




Private Sub FormatWS(s As String)
With Worksheets(s)
.Activate
.Cells(1, 1).CurrentRegion.EntireColumn.ColumnWidth = 200
.Cells(1, 1).CurrentRegion.EntireRow.AutoFit
.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit

.Range("A2").Select
End With

With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With

End Sub

[mightymorgs]

Thanks Paul! I'll give that a try and see if it works. I appreciate you taking the time to "red pen" my code! Truly.