Hi All,
I've made 2 example spreadsheets to show what I'm trying to do, and I'm almost there, but stuck on the last bit.
VBA code for the filtered workbook buttons are at the bottom
I'm trying to copy rows from the main workbook ('Inventory.xlsm') from specific pages (in the example, pages 'AA.BB', 'CC.DD' and 'GG.HH'), to another workbook ('Filtered.xlsm') with the data on sheet ('FilteredData').
The spreadsheet that it will be eventually used on will contain hundreds of pages, so the page names need to be specific as it will only need to pull the data from those specific pages.
The main workbook in this example ('Inventory.xlsm') cannot be amended, only the workbook ('Filtered.xlsm') can be changed to get this data.
From the main workbook, ('Inventory.xlsm'), I want to copy the rows where column I is not zero (columns to copy are B to I, but column G takes the minimum date from column N to O), between rows 2 and 99 (this also needs to be specific rows as there is other data above and below on the actual real workbook). The data between rows 2 and 99 will start at row 2, and continue down line by line. Once a blank line is reached between 2 and 99, there will be nothing else below that row that is needed. This data needs to be copied to the new workbook ('Filtered.xlsm').
As you can see from the screenshots, I have a button to press that takes the data from the main workbook specific pages, and copies it to the new filtered workbook (in to columns A to H). It then filters the new column H to exclude zero, only leaving the data 1 or above.
In my example, everything that I want to copy seems to copy fine, except for column F which is a date, as this is copied as the main workbook formula which no longer has the 2 dates to choose the minimum date from. I've tried putting in PasteSpecial Paste:=xlPasteValues which was suggested from other problems that I've seen people having, but I can't figure out where to put it as I've tried many places in the code and it just throws up errors.
So my question is:
1) How can I copy the data so the date copies what the 'Inventory.xlsm' workbook says, and not the formula which will then try to reference incorrect cells on the new filtered workbook.
2) If there's a better way to copy the original data to only copy the rows where I is not zero instead of copying everything and then filtering, I'm open to help on this too.
If you got this far, thanks in advance
David.
Sub Macro1()
Dim lr As Long, lc As Long, lr2 As Long
Dim arr As Variant, sh As Variant
Dim sPrint As Worksheet
On Error GoTo Start
ActiveWorkbook.ActiveSheet.ShowAllData
Start:
Application.ScreenUpdating = False
Set sPrint = Sheets("FilteredData")
sPrint.Cells.Clear
Workbooks("Inventory.xlsm").Activate
arr = Array("AA.BB", "CC.DD", "GG.HH")
lr2 = 4
For Each sh In arr
With Sheets(sh)
lr = .Range("B" & Rows.Count).End(3).Row
lc = .Cells(4, 9).End(3).Column
.Range("B1", .Cells(lr, lc)).Copy sPrint.Range("A" & lr2)
lr2 = sPrint.Range("B" & Rows.Count).End(3).Row + 3
End With
Next
Application.ScreenUpdating = True
Selection.Copy
Windows("Filtered.xlsm").Activate
On Error GoTo Protection
If ActiveWorkbook.ActiveSheet.FilterMode Or _
ActiveWorkbook.ActiveSheet.AutoFilterMode Then _
ActiveWorkbook.ActiveSheet.ShowAllData.PasteSpecial Paste:=xlPasteValues
Workbooks("Filtered.xlsm").Activate
ActiveSheet.Range("$A$4:$H$285").AutoFilter Field:=8, Criteria1:="<>0"
Range("A1").Select
Exit Sub
Protection:
If Err.Number = 1004 And Err.Description = _
"ShowAllData method of Worksheet class failed" Then
MsgBox "There are no filters to clear!", _
vbInformation
ActiveSheet.Range("$B$7:$I$285").AutoFilter Field:=8, Criteria1:="<>0"
End If
Workbooks("Filtered.xlsm").Activate
Range("A1").Select
End Sub
Sub ClearData()
On Error GoTo Start
ActiveSheet.ShowAllData
Start:
ActiveSheet.Cells.Clear
End Sub
I've made 2 example spreadsheets to show what I'm trying to do, and I'm almost there, but stuck on the last bit.
VBA code for the filtered workbook buttons are at the bottom
I'm trying to copy rows from the main workbook ('Inventory.xlsm') from specific pages (in the example, pages 'AA.BB', 'CC.DD' and 'GG.HH'), to another workbook ('Filtered.xlsm') with the data on sheet ('FilteredData').
The spreadsheet that it will be eventually used on will contain hundreds of pages, so the page names need to be specific as it will only need to pull the data from those specific pages.
The main workbook in this example ('Inventory.xlsm') cannot be amended, only the workbook ('Filtered.xlsm') can be changed to get this data.
From the main workbook, ('Inventory.xlsm'), I want to copy the rows where column I is not zero (columns to copy are B to I, but column G takes the minimum date from column N to O), between rows 2 and 99 (this also needs to be specific rows as there is other data above and below on the actual real workbook). The data between rows 2 and 99 will start at row 2, and continue down line by line. Once a blank line is reached between 2 and 99, there will be nothing else below that row that is needed. This data needs to be copied to the new workbook ('Filtered.xlsm').
As you can see from the screenshots, I have a button to press that takes the data from the main workbook specific pages, and copies it to the new filtered workbook (in to columns A to H). It then filters the new column H to exclude zero, only leaving the data 1 or above.
In my example, everything that I want to copy seems to copy fine, except for column F which is a date, as this is copied as the main workbook formula which no longer has the 2 dates to choose the minimum date from. I've tried putting in PasteSpecial Paste:=xlPasteValues which was suggested from other problems that I've seen people having, but I can't figure out where to put it as I've tried many places in the code and it just throws up errors.
So my question is:
1) How can I copy the data so the date copies what the 'Inventory.xlsm' workbook says, and not the formula which will then try to reference incorrect cells on the new filtered workbook.
2) If there's a better way to copy the original data to only copy the rows where I is not zero instead of copying everything and then filtering, I'm open to help on this too.
If you got this far, thanks in advance
David.
Sub Macro1()
Dim lr As Long, lc As Long, lr2 As Long
Dim arr As Variant, sh As Variant
Dim sPrint As Worksheet
On Error GoTo Start
ActiveWorkbook.ActiveSheet.ShowAllData
Start:
Application.ScreenUpdating = False
Set sPrint = Sheets("FilteredData")
sPrint.Cells.Clear
Workbooks("Inventory.xlsm").Activate
arr = Array("AA.BB", "CC.DD", "GG.HH")
lr2 = 4
For Each sh In arr
With Sheets(sh)
lr = .Range("B" & Rows.Count).End(3).Row
lc = .Cells(4, 9).End(3).Column
.Range("B1", .Cells(lr, lc)).Copy sPrint.Range("A" & lr2)
lr2 = sPrint.Range("B" & Rows.Count).End(3).Row + 3
End With
Next
Application.ScreenUpdating = True
Selection.Copy
Windows("Filtered.xlsm").Activate
On Error GoTo Protection
If ActiveWorkbook.ActiveSheet.FilterMode Or _
ActiveWorkbook.ActiveSheet.AutoFilterMode Then _
ActiveWorkbook.ActiveSheet.ShowAllData.PasteSpecial Paste:=xlPasteValues
Workbooks("Filtered.xlsm").Activate
ActiveSheet.Range("$A$4:$H$285").AutoFilter Field:=8, Criteria1:="<>0"
Range("A1").Select
Exit Sub
Protection:
If Err.Number = 1004 And Err.Description = _
"ShowAllData method of Worksheet class failed" Then
MsgBox "There are no filters to clear!", _
vbInformation
ActiveSheet.Range("$B$7:$I$285").AutoFilter Field:=8, Criteria1:="<>0"
End If
Workbooks("Filtered.xlsm").Activate
Range("A1").Select
End Sub
Sub ClearData()
On Error GoTo Start
ActiveSheet.ShowAllData
Start:
ActiveSheet.Cells.Clear
End Sub
