sspatriots
Well-known Member
- Joined
- Nov 22, 2011
- Messages
- 585
- Office Version
- 365
- Platform
- Windows
I posted the first part of my code earlier, but now I need expand it to allow sorting of other columns in the source table and extracting information from them to be added to the destination table. I keep getting the subject error at the line below in my code:
The reason for this is that when I filter the column (using the line of code below) for dates within the next 7 days, the result is no data in that column falling within that date range, therefor I end up with an empty set of data for the result when filtering on this particular column. It will probably happen to other columns I try to filter as I add them to this code later on.
I tried using various techniques I found on this group to trap it, but nothing seems to work or I'm just not doing something correctly. Any help would be greatly appreciated.
Below is the complete code so far:
VBA Code:
Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy
The reason for this is that when I filter the column (using the line of code below) for dates within the next 7 days, the result is no data in that column falling within that date range, therefor I end up with an empty set of data for the result when filtering on this particular column. It will probably happen to other columns I try to filter as I add them to this code later on.
VBA Code:
ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col6, Criteria1:=">=" & Date, Operator:= _
xlAnd, Criteria2:="<=" & Date + 7
I tried using various techniques I found on this group to trap it, but nothing seems to work or I'm just not doing something correctly. Any help would be greatly appreciated.
Below is the complete code so far:
VBA Code:
Sub PopulateOrderByReportWS()
'
' Populate Order By Report WS Macro
'
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim tb1 As ListObject
Dim tb2 As ListObject
Dim lc1 As ListColumn
Dim lc2 As ListColumn
Dim lc3 As ListColumn
Dim lc4 As ListColumn
Dim lc5 As ListColumn
Dim lc6 As ListColumn
Dim Rng1 As Range
Dim col1 As Long
Dim col2 As Long
Dim col3 As Long
Dim col4 As Long
Dim col5 As Long
Dim col6 As Long
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 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Jack" & Chr(10) & "PO")
Set lc2 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Jack" & Chr(10) & "Order By" & Chr(10) & "Date")
Set lc3 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "PO")
Set lc4 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Machine" & Chr(10) & "Order By" & Chr(10) & "Date")
Set lc5 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Safety" & Chr(10) & "PO")
Set lc6 = Sheets("Jobs").ListObjects("G2JobList").ListColumns("Safety" & Chr(10) & "Order By" & Chr(10) & "Date")
col1 = lc1.Range.Column
col2 = lc2.Range.Column
col3 = lc3.Range.Column
col4 = lc4.Range.Column
col5 = lc5.Range.Column
col6 = lc6.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:=col1
ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col2, Criteria1:=">=" & Date, Operator:= _
xlAnd, Criteria2:="<=" & Date + 7
With tb1
On Error GoTo EQPT2
Ws2.Activate
Range("G2JobList[[Job Name]]").SpecialCells(xlCellTypeVisible).Copy
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
Range("G2JobList[[Jack" & Chr(10) & "Vendor]], G2JobList[[Jack" & Chr(10) & "Order By" & Chr(10) & "Date]]").SpecialCells(xlCellTypeVisible).Copy
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
With tb2.Range.Borders()
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
For Each Rng1 In Ws2.Range("Order_By_Report[[Equipment]]")
If Rng1 = vbNullString Then Rng1 = "Jack"
' If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("Machine" & Chr(10) & "Vendor")
lRw = Cells(Rows.Count, 1).End(xlUp).Row
Next
EQPT2:
Ws1.Activate
ActiveSheet.ListObjects("G2JobList").Range.AutoFilter 'Clear previous filters
ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col3
ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col4, Criteria1:=">=" & Date, Operator:= _
xlAnd, Criteria2:="<=" & Date + 7
With tb1
On Error GoTo EQPT3
Range("G2JobList[[Job Name]], G2JobList[[MFR" & Chr(10) & "Machine" & Chr(10) & "PN]], G2JobList[[Machine" & Chr(10) & "Vendor]], G2JobList[[Machine" & Chr(10) & "Order By" & Chr(10) & "Date]]").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
With tb2.Range.Borders()
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
For Each Rng1 In Ws2.Range("Order_By_Report[[Equipment]]")
If Rng1 = vbNullString Then Rng1 = "Machine"
' If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("Machine" & Chr(10) & "Vendor")
lRw = Cells(Rows.Count, 1).End(xlUp).Row
Next
EQPT3:
Ws1.Activate
ActiveSheet.ListObjects("G2JobList").Range.AutoFilter 'Clear previous filters
ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col5
ActiveSheet.ListObjects("G2JobList").Range.AutoFilter Field:=col6, Criteria1:=">=" & Date, Operator:= _
xlAnd, Criteria2:="<=" & Date + 7
With tb1
On Error GoTo EQPT4
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
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 = Columns(.Column).Resize(, .Columns.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Cells(n + 1, .Column).PasteSpecial xlPasteValues
End With
With tb2.Range.Borders()
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End With
For Each Rng1 In Ws2.Range("Order_By_Report[[Equipment]]")
If Rng1 = vbNullString Then Rng1 = "Safety"
' If Rng1 = vbNullString Then Rng1 = tb1.ListColumns("Machine" & Chr(10) & "Vendor")
lRw = Cells(Rows.Count, 1).End(xlUp).Row
Next
EQPT4:
'Code for next column will go here
Application.Goto Reference:=Range("A" & lRw), Scroll:=True
Range("B3").Activate
End Sub