Results 1 to 3 of 3

Thread: Help fixing and cleaning up code

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1

    Help fixing and cleaning up code

    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

    Attached Files Attached Files
    Last edited by Paul_Hossler; 01-04-2022 at 08:01 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •