Trying to eliminate having to activate the destination worksheet (ws2) in my macro

S

sspatriots

Well-known Member
Joined
Nov 22, 2011
Messages
585
Office Version
  1. 365
Platform
  1. Windows
Hi,

I'm not sure if the bit of code below is enough to get the help I need or not. The code is extremely long, and I can post more of it if needed. This bit basically copies a filtered portion of one column in one table to a second table in another worksheet. Trying to figure out how to re-write this and avoid having to activate "ws2" if possible. Right now as it stands, when I remove the ws2 activate line, the destination table doesn't populate the information in the destination table on the second worksheet. Thanks, SS

VBA Code: 
'Safety
EQPT3:

    '    ws1.Activate

    ws1.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    ws1.ListObjects("G2JobList").Range.AutoFilter Field:=col99, Criteria1:="<>"
    ws1.ListObjects("G2JobList").Range.AutoFilter Field:=col5, Criteria1:="="
    ws1.ListObjects("G2JobList").Range.AutoFilter Field:=col6, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 28

    With tb1

        On Error GoTo EQPT4

        If ws1.Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            ws1.Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy


                ws2.Activate

            With ws2.Range("Order_By_Report[[Job Name]]")
                n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If
    End With    'Temporary

'Governor    'Temporary
EQPT4:    'Temporary
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
sspatriots said:
Right now as it stands, when I remove the ws2 activate line, the destination table doesn't populate the information in the destination table on the second worksheet. Thanks, SS
Click to expand...

That's because you have an unqualified cell reference here:

VBA Code: 
 Cells(n + 1, .Column).PasteSpecial xlPasteValues

Cells(n + 1, .Column) refers to the ActiveSheet cells, not ws2 cells.

To have it reference ws2 it would need to be

VBA Code: 
 ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
 
Upvote 0
Same with Columns I suspect.

Also note that if you have more of those On Error GoTo EQPT4 type statements, only the first error will be handled, as that is not correct error handling - you are missing a Resume statement of some kind. And if you do have more of those, your procedure really needs refactoring into separate routines.
 
Upvote 0
Hi,

I apologize for not getting back sooner. I've been down with the flu for the past 5 or so days. Thanks for the inputs. I did go back and put the "ws2." in front of the cell reference as well as commented out the "On Error" bit.

However, my code still doesn't populate the destination table with the filtered information from the source table. I did notice that the information is now being pasted on the destination worksheet beneath the table at the exact row numbers they came from in the source table. I'm sure, I have something jumbled up here, but for the life of me, I cannot get past this one.

Any additional assistance would be much appreciated. Here is the code with the first part declaring all the variables and a couple sections of the code that is supposed to copy the filtered data over to the destination table. Thanks, SS

VBA Code: 
Sub PopulateOrderByReportWS_WKG1()
'
' Populate Order By Report WS Macro
'
    Application.ScreenUpdating = True
    Application.EnableEvents = False
    Application.DisplayAlerts = True

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim tb1 As ListObject
    Dim tb2 As ListObject
    Dim lc1, lc2, lc3, lc4, lc5, lc6, lc7, lc8, lc9, lc10, lc11, lc12, lc13, lc14, lc15, lc16, lc17, lc18 As ListColumn
    Dim lc19, lc20, lc21, lc22, lc23, lc24, lc25, lc26, lc27, lc28, lc29, lc30, lc31, lc32, lc33, lc34, lc99 As ListColumn
    Dim rng1 As Range
    Dim i As Long
    Dim lRw As Long
    
    Set ws1 = Sheets("Jobs") 'Worksheet the G2JobList (Source) Table is on
    Set ws2 = Sheets("Order By Report") 'Worksheet the Order_By_Report (Destination) Table is on
    
    Set tb1 = ws1.ListObjects("G2JobList") 'Source Table
    Set tb2 = ws2.ListObjects("Order_By_Report")  'Destination Table
    
    Set lc1 = ws1.ListObjects("G2JobList").ListColumns("Jack" & Chr(10) & "PO")
    Set lc2 = ws1.ListObjects("G2JobList").ListColumns("Jack" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc3 = ws1.ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "PO")
    Set lc4 = ws1.ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc5 = ws1.ListObjects("G2JobList").ListColumns("Safety" & Chr(10) & "PO")
    Set lc6 = ws1.ListObjects("G2JobList").ListColumns("Safety" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc7 = ws1.ListObjects("G2JobList").ListColumns("Governor" & Chr(10) & "PO")
    Set lc8 = ws1.ListObjects("G2JobList").ListColumns("Governor" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc9 = ws1.ListObjects("G2JobList").ListColumns("Tail Sheave" & Chr(10) & "PO")
    Set lc10 = ws1.ListObjects("G2JobList").ListColumns("Tail Sheave" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc11 = ws1.ListObjects("G2JobList").ListColumns("Roller Guides" & Chr(10) & "PO")
    Set lc12 = ws1.ListObjects("G2JobList").ListColumns("Roller Guides" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc13 = ws1.ListObjects("G2JobList").ListColumns("COMP Chain" & Chr(10) & "PO")
    Set lc14 = ws1.ListObjects("G2JobList").ListColumns("COMP Chain" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc15 = ws1.ListObjects("G2JobList").ListColumns("Ropes" & Chr(10) & "PO")
    Set lc16 = ws1.ListObjects("G2JobList").ListColumns("Ropes" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc17 = ws1.ListObjects("G2JobList").ListColumns("Oil Buffers" & Chr(10) & "PO")
    Set lc18 = ws1.ListObjects("G2JobList").ListColumns("Oil Buffers" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc19 = ws1.ListObjects("G2JobList").ListColumns("Rails" & Chr(10) & "PO")
    Set lc20 = ws1.ListObjects("G2JobList").ListColumns("Rails" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc21 = ws1.ListObjects("G2JobList").ListColumns("CWT" & Chr(10) & "PO")
    Set lc22 = ws1.ListObjects("G2JobList").ListColumns("CWT" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc23 = ws1.ListObjects("G2JobList").ListColumns("Cab" & Chr(10) & "PO")
    Set lc24 = ws1.ListObjects("G2JobList").ListColumns("Cab" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc25 = ws1.ListObjects("G2JobList").ListColumns("ENT" & Chr(10) & "PO")
    Set lc26 = ws1.ListObjects("G2JobList").ListColumns("ENT" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc27 = ws1.ListObjects("G2JobList").ListColumns("FXTR" & Chr(10) & "PO")
    Set lc28 = ws1.ListObjects("G2JobList").ListColumns("FXTR" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc29 = ws1.ListObjects("G2JobList").ListColumns("CONTR" & Chr(10) & "PO")
    Set lc30 = ws1.ListObjects("G2JobList").ListColumns("CONTR" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc31 = ws1.ListObjects("G2JobList").ListColumns("Door EQPT" & Chr(10) & "PO")
    Set lc32 = ws1.ListObjects("G2JobList").ListColumns("Door EQPT" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc33 = ws1.ListObjects("G2JobList").ListColumns("Wiring" & Chr(10) & "PO")
    Set lc34 = ws1.ListObjects("G2JobList").ListColumns("Wiring" & Chr(10) & "Order By" & Chr(10) & "Date")
    
    Set lc99 = ws1.ListObjects("G2JobList").ListColumns("G1" & Chr(10) & "Job #")
    
    col1 = lc1.Range.Column
    col2 = lc2.Range.Column
    col3 = lc3.Range.Column
    col4 = lc4.Range.Column
    col5 = lc5.Range.Column
    col6 = lc6.Range.Column
    col7 = lc7.Range.Column
    col8 = lc8.Range.Column
    col9 = lc9.Range.Column
    col10 = lc10.Range.Column
    col11 = lc11.Range.Column
    col12 = lc12.Range.Column
    col13 = lc13.Range.Column
    col14 = lc14.Range.Column
    col15 = lc15.Range.Column
    col16 = lc16.Range.Column
    col17 = lc17.Range.Column
    col18 = lc18.Range.Column
    col19 = lc19.Range.Column
    col20 = lc20.Range.Column
    col21 = lc21.Range.Column
    col22 = lc22.Range.Column
    col23 = lc23.Range.Column
    col24 = lc24.Range.Column
    col25 = lc25.Range.Column
    col26 = lc26.Range.Column
    col27 = lc27.Range.Column
    col28 = lc28.Range.Column
    col29 = lc29.Range.Column
    col30 = lc30.Range.Column
    col31 = lc31.Range.Column
    col32 = lc32.Range.Column
    col33 = lc33.Range.Column
    col34 = lc34.Range.Column

    col99 = lc99.Range.Column

    'ws2.Activate

    On Error Resume Next
    tb2.DataBodyRange.Delete


    ws1.Activate

    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col99, Criteria1:="<>"
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col5, Criteria1:="="
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col6, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 28

    With tb1

'        On Error GoTo EQPT4

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy

'            ws2.Activate

            With Range("Order_By_Report[[Job Name]]")
                n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[G1" & Chr(10) & "Job '#]]").SpecialCells(xlCellTypeVisible).Copy

'            ws2.Activate

            With Range("Order_By_Report[[Job '#]]")
                n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[Safety" & Chr(10) & "Vendor]], G2JobList[[Safety" & Chr(10) & "Order By" & Chr(10) & "Date]]").SpecialCells(xlCellTypeVisible).Copy

'            ws2.Activate

            With Range("Order_By_Report[[Vendor]]")
                n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        With tb2.Range.Borders()
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With

    End With

    If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
        For Each rng1 In ws2.Range("Order_By_Report[[Equipment]]")
            If rng1 = vbNullString Then rng1 = "Safety"
    '        If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("Safety" & Chr(10) & "Vendor")

            lRw = Cells(Rows.Count, 1).End(xlUp).Row

        Next
    End If


'EQPT4:

    ws1.Activate

    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col99, Criteria1:="<>"
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col7, Criteria1:="="
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col8, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 28

    With tb1

'        On Error GoTo EQPT5

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy

'            ws2.Activate

            With Range("Order_By_Report[[Job Name]]")
                n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[G1" & Chr(10) & "Job '#]]").SpecialCells(xlCellTypeVisible).Copy

'            ws2.Activate

            With Range("Order_By_Report[[Job '#]]")
                n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[Governor" & Chr(10) & "Vendor]], G2JobList[[Governor" & Chr(10) & "Order By" & Chr(10) & "Date]]").SpecialCells(xlCellTypeVisible).Copy

'            ws2.Activate

            With Range("Order_By_Report[[Vendor]]")
                n = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        With tb2.Range.Borders()
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With

    End With

    If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
        For Each rng1 In ws2.Range("Order_By_Report[[Equipment]]")
            If rng1 = vbNullString Then rng1 = "Governor"
    '        If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("Governor" & Chr(10) & "Vendor")

            lRw = Cells(Rows.Count, 1).End(xlUp).Row

        Next
    End If


'EQPT5:


    
    ws1.Activate
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    Range("A1").Select
    Set cell = ActiveCell
    ActiveWindow.ScrollRow = cell.Row
    Range("A3").Select
    
    ws2.Activate
    Range("B1").Select
    Set cell = ActiveCell
    ActiveWindow.ScrollRow = cell.Row
    Range("B3").Select
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True

End Sub
 
Upvote 0
Why are you setting all those listcolumn objects when you don't use most of them?

The reason the data is going to the wrong place is because you are still using Columns not ws2.Columns

I strongly suggest you stop using line feeds in your column names too; it just makes life difficult.
 
Upvote 0
Why are you setting all those listcolumn objects when you don't use most of them?
Click to expand...
I actually do use off of the listcolumn objects. I just removed most of the code pertaining to them as it is almost identical to the few that I left in there to short up the macro for my post.


The reason the data is going to the wrong place is because you are still using Columns not ws2.Columns
Click to expand...
I need to take a closer look at this part and figure out where you are referring to.


I strongly suggest you stop using line feeds in your column names too; it just makes life difficult.
Click to expand...
I'm not sure what you mean by line feeds. Sorry, still figuring VBA out as I chug along here.
 
Upvote 0
Someone has used Alt+enter to get separate lines in the column header text.
 
Upvote 0
I played around with it and added the "ws2." reference ahead of the column for "n" and it seems to work like it should. If you have any examples of how I can clean this up and shorten it to do the same thing I would appreciate seeing them. Thanks again for all the inputs.

Here is what I ended up with for now that seems to be working at the moment:

VBA Code: 
Sub PopulateOrderByReportWS_WKG1()
'
' Populate Order By Report WS Macro
'
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim tb1 As ListObject
    Dim tb2 As ListObject
    Dim lc1, lc2, lc3, lc4, lc5, lc6, lc7, lc8, lc9, lc10, lc11, lc12, lc13, lc14, lc15, lc16, lc17, lc18 As ListColumn
    Dim lc19, lc20, lc21, lc22, lc23, lc24, lc25, lc26, lc27, lc28, lc29, lc30, lc31, lc32, lc33, lc34, lc99 As ListColumn
    Dim rng1 As Range
    Dim i As Long
    Dim lRw As Long
    
    Set ws1 = Sheets("Jobs") 'Worksheet the G2JobList (Source) Table is on
    Set ws2 = Sheets("Order By Report") 'Worksheet the Order_By_Report (Destination) Table is on
    
    Set tb1 = ws1.ListObjects("G2JobList") 'Source Table
    Set tb2 = ws2.ListObjects("Order_By_Report")  'Destination Table
    
    Set lc1 = ws1.ListObjects("G2JobList").ListColumns("Jack" & Chr(10) & "PO")
    Set lc2 = ws1.ListObjects("G2JobList").ListColumns("Jack" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc3 = ws1.ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "PO")
    Set lc4 = ws1.ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc5 = ws1.ListObjects("G2JobList").ListColumns("Safety" & Chr(10) & "PO")
    Set lc6 = ws1.ListObjects("G2JobList").ListColumns("Safety" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc7 = ws1.ListObjects("G2JobList").ListColumns("Governor" & Chr(10) & "PO")
    Set lc8 = ws1.ListObjects("G2JobList").ListColumns("Governor" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc9 = ws1.ListObjects("G2JobList").ListColumns("Tail Sheave" & Chr(10) & "PO")
    Set lc10 = ws1.ListObjects("G2JobList").ListColumns("Tail Sheave" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc11 = ws1.ListObjects("G2JobList").ListColumns("Roller Guides" & Chr(10) & "PO")
    Set lc12 = ws1.ListObjects("G2JobList").ListColumns("Roller Guides" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc13 = ws1.ListObjects("G2JobList").ListColumns("COMP Chain" & Chr(10) & "PO")
    Set lc14 = ws1.ListObjects("G2JobList").ListColumns("COMP Chain" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc15 = ws1.ListObjects("G2JobList").ListColumns("Ropes" & Chr(10) & "PO")
    Set lc16 = ws1.ListObjects("G2JobList").ListColumns("Ropes" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc17 = ws1.ListObjects("G2JobList").ListColumns("Oil Buffers" & Chr(10) & "PO")
    Set lc18 = ws1.ListObjects("G2JobList").ListColumns("Oil Buffers" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc19 = ws1.ListObjects("G2JobList").ListColumns("Rails" & Chr(10) & "PO")
    Set lc20 = ws1.ListObjects("G2JobList").ListColumns("Rails" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc21 = ws1.ListObjects("G2JobList").ListColumns("CWT" & Chr(10) & "PO")
    Set lc22 = ws1.ListObjects("G2JobList").ListColumns("CWT" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc23 = ws1.ListObjects("G2JobList").ListColumns("Cab" & Chr(10) & "PO")
    Set lc24 = ws1.ListObjects("G2JobList").ListColumns("Cab" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc25 = ws1.ListObjects("G2JobList").ListColumns("ENT" & Chr(10) & "PO")
    Set lc26 = ws1.ListObjects("G2JobList").ListColumns("ENT" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc27 = ws1.ListObjects("G2JobList").ListColumns("FXTR" & Chr(10) & "PO")
    Set lc28 = ws1.ListObjects("G2JobList").ListColumns("FXTR" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc29 = ws1.ListObjects("G2JobList").ListColumns("CONTR" & Chr(10) & "PO")
    Set lc30 = ws1.ListObjects("G2JobList").ListColumns("CONTR" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc31 = ws1.ListObjects("G2JobList").ListColumns("Door EQPT" & Chr(10) & "PO")
    Set lc32 = ws1.ListObjects("G2JobList").ListColumns("Door EQPT" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc33 = ws1.ListObjects("G2JobList").ListColumns("Wiring" & Chr(10) & "PO")
    Set lc34 = ws1.ListObjects("G2JobList").ListColumns("Wiring" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc99 = ws1.ListObjects("G2JobList").ListColumns("G1" & Chr(10) & "Job #")
    
    Set Acell = ActiveCell

    col1 = lc1.Range.Column
    col2 = lc2.Range.Column
    col3 = lc3.Range.Column
    col4 = lc4.Range.Column
    col5 = lc5.Range.Column
    col6 = lc6.Range.Column
    col7 = lc7.Range.Column
    col8 = lc8.Range.Column
    col9 = lc9.Range.Column
    col10 = lc10.Range.Column
    col11 = lc11.Range.Column
    col12 = lc12.Range.Column
    col13 = lc13.Range.Column
    col14 = lc14.Range.Column
    col15 = lc15.Range.Column
    col16 = lc16.Range.Column
    col17 = lc17.Range.Column
    col18 = lc18.Range.Column
    col19 = lc19.Range.Column
    col20 = lc20.Range.Column
    col21 = lc21.Range.Column
    col22 = lc22.Range.Column
    col23 = lc23.Range.Column
    col24 = lc24.Range.Column
    col25 = lc25.Range.Column
    col26 = lc26.Range.Column
    col27 = lc27.Range.Column
    col28 = lc28.Range.Column
    col29 = lc29.Range.Column
    col30 = lc30.Range.Column
    col31 = lc31.Range.Column
    col32 = lc32.Range.Column
    col33 = lc33.Range.Column
    col34 = lc34.Range.Column
    col99 = lc99.Range.Column

    On Error Resume Next
    tb2.DataBodyRange.Delete


    
'EQPT3
    
    ws1.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    ws1.ListObjects("G2JobList").Range.AutoFilter Field:=col99, Criteria1:="<>"
    ws1.ListObjects("G2JobList").Range.AutoFilter Field:=col5, Criteria1:="="
    ws1.ListObjects("G2JobList").Range.AutoFilter Field:=col6, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 28

    With tb1

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy

            With Range("Order_By_Report[[Job Name]]")
                n = ws2.Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[G1" & Chr(10) & "Job '#]]").SpecialCells(xlCellTypeVisible).Copy

            With Range("Order_By_Report[[Job '#]]")
                n = ws2.Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[Safety" & Chr(10) & "Vendor]], G2JobList[[Safety" & Chr(10) & "Order By" & Chr(10) & "Date]]").SpecialCells(xlCellTypeVisible).Copy

            With Range("Order_By_Report[[Vendor]]")
                n = ws2.Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        With tb2.Range.Borders()
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With

    End With

    If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
        For Each rng1 In ws2.Range("Order_By_Report[[Equipment]]")
            If rng1 = vbNullString Then rng1 = "Safety"

            lRw = ws2.Cells(Rows.Count, 1).End(xlUp).Row

        Next
    End If


'EQPT4

    ws1.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    ws1.ListObjects("G2JobList").Range.AutoFilter Field:=col99, Criteria1:="<>"
    ws1.ListObjects("G2JobList").Range.AutoFilter Field:=col7, Criteria1:="="
    ws1.ListObjects("G2JobList").Range.AutoFilter Field:=col8, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 28

    With tb1

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy

            With Range("Order_By_Report[[Job Name]]")
                n = ws2.Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[G1" & Chr(10) & "Job '#]]").SpecialCells(xlCellTypeVisible).Copy

            With Range("Order_By_Report[[Job '#]]")
                n = ws2.Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[Governor" & Chr(10) & "Vendor]], G2JobList[[Governor" & Chr(10) & "Order By" & Chr(10) & "Date]]").SpecialCells(xlCellTypeVisible).Copy

            With Range("Order_By_Report[[Vendor]]")
                n = ws2.Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws2.Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

        With tb2.Range.Borders()
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With

    End With

    If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
        For Each rng1 In ws2.Range("Order_By_Report[[Equipment]]")
            If rng1 = vbNullString Then rng1 = "Governor"

            lRw = ws2.Cells(Rows.Count, 1).End(xlUp).Row

        Next
    End If


'EQPT5

   
    ws1.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    ws1.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    Application.Goto Acell

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True

End Sub
 
Upvote 0
RoryA said:
Someone has used Alt+enter to get separate lines in the column header text.
Click to expand...
Gotcha, the columns were all named like that when I came to work here. Tried changing them once and got a bunch of grief over it.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Run-time error '1004': No cells were found.
Replies
4
Views
1K
sspatriots
S
S
  • Solved
Trying to copy another column from one table to another.
Replies
2
Views
577
Alex Blakenburg
A
S
  • Solved
Copying Filtered Columns (non-adjacent) from one Table to end of another, but need to also add information in adjacent column of Destination Table
Replies
1
Views
576
sspatriots
S
S
  • Solved
Tweak Macro that Imports specific table columns from a different workbook to filter a column first
Replies
4
Views
447
sspatriots
S
S
  • Solved
Macro to filter each column for cells that appear empty, clear the contents and move to the next column for entire table
Replies
3
Views
540
sspatriots
S

Forum statistics

Threads
1,223,880
Messages
6,175,152
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top