Trying to copy another column from one table to another.

S

sspatriots

Well-known Member
Joined
Nov 22, 2011
Messages
585
Office Version
  1. 365
Platform
  1. Windows
Below is the same code I was working on yesterday, except that I've shortened it up a little to pinpoint the part I'm having an issue with. I did manage to get everything to work this morning after the help I received yesterday in this forum just after making that particular post. Since then, I was asked by my manager to go back and add another column to the new table and copy that information from the source table over as well. However, you can see with the code below where my code just kicks me out and goes to the error reference "EQPT11". It's as if it will not recognize the column "G1" & Chr(10) & "Job #" from the source table that I'm adding at all.

New column added to destination table:
Order By Report.jpg


Any help with clearing this up would be much appreciated. Thanks, SS

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

    Dim Ws2 As Worksheet
    
    Dim tb2 As ListObject
    
    Set Ws2 = Sheets("Order By Report") 'Worksheet the Order_By_Report (Destination) Table is on
    
    Set tb2 = Ws2.ListObjects("Order_By_Report")  'Destination Table

    On Error Resume Next
    tb2.DataBodyRange.Delete

End Sub

Sub PopulateOrderByReportWS()
'
' 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 lc19 As ListColumn
    Dim lc20 As ListColumn
    Dim lc21 As ListColumn
    Dim lc22 As ListColumn

    Dim col19 As Long
    Dim col20 As Long
    Dim col21 As Long
    Dim col22 As Long

    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 lc19 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Rails" & Chr(10) & "PO")
    Set lc20 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Rails" & Chr(10) & "Order By" & Chr(10) & "Date")
    Set lc21 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("CWT" & Chr(10) & "PO")
    Set lc22 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("CWT" & Chr(10) & "Order By" & Chr(10) & "Date")
    
    col19 = lc19.Range.Column
    col20 = lc20.Range.Column
    col21 = lc21.Range.Column
    col22 = lc22.Range.Column

    Ws2.Activate

    On Error Resume Next
    tb2.DataBodyRange.Delete



'EQPT10:
    
    Ws1.Activate
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col19
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col20, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 7
    
    With tb1

        On Error GoTo EQPT11
      
        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
                Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If
     
[COLOR=rgb(226, 80, 65)]''''''''''''''ADDING FROM HERE''''''''''''''''''''''

        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
                Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If

' '''''''''''''TO HERE''''''''''''''''''''''[/COLOR]
        
        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[Rails" & Chr(10) & "Vendor]], G2JobList[[Rails" & 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
                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 = "Rails"
    '        If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("Rails" & Chr(10) & "Vendor")
        
            lRw = Cells(Rows.Count, 1).End(xlUp).Row
         
        Next
    End If
    
   
EQPT11:
    
    Ws1.Activate
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter   'Clear previous filters
    
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col21
    ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col22, Criteria1:=">=" & Date, Operator:= _
        xlAnd, Criteria2:="<=" & Date + 7
    
    With tb1

        On Error GoTo EQPT12
      
        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
                Cells(n + 1, .Column).PasteSpecial xlPasteValues
            End With
        End If
        
        If Range("G2JobList[[#All],[Job Name]]").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Range("G2JobList[[CWT" & Chr(10) & "Vendor]], G2JobList[[CWT" & 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
                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 = "CWT"
    '        If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("CWT" & Chr(10) & "Vendor")
        
            lRw = Cells(Rows.Count, 1).End(xlUp).Row
         
        Next
    End If
    
   
EQPT12:
   
    
    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
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
Ok, I just found the issue. I just need to add the single quote mark before the hashtag symbol.

From this: #
To this: '#
 
Upvote 0
Solution
sspatriots said:
Ok, I just found the issue. I just need to add the single quote mark before the hashtag symbol.

From this: #
To this: '#
Click to expand...
That's a great tip. Thanks for posting. (y)
I thought perhaps you had the single quote in the cell but obviously you didn't.

Rich (BB code): 
    Dim rng As Range
    Set rng = Range("G2JobList[[G1" & Chr(10) & "Job '#]]").SpecialCells(xlCellTypeVisible)

1701326502553.png
 
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
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
580
sspatriots
S
S
  • Question Question
Trying to eliminate having to activate the destination worksheet (ws2) in my macro
2
Replies
10
Views
633
sspatriots
S
S
  • Solved
Tweak Macro that Imports specific table columns from a different workbook to filter a column first
Replies
4
Views
507
sspatriots
S
S
  • Solved
Need value to be the Table Column Header in lieu of Cell Address
Replies
1
Views
473
sspatriots
S

Forum statistics

Threads
1,224,809
Messages
6,181,075
Members
453,020
Latest member
mattg2448

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