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




Reply With Quote