Can anyone troubleshoot my code?

[outlawdevil]

    Sub CopyFilteredData()
    Dim sName1 As String
    Dim sName2 As String
    Dim sName3 As String
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim Last As Long
    
    ''
    ''
    sName1 = "Blue"
    sName2 = "Red"
    sName3 = "white"
    Set sh1 = Sheets("Data Tab")
    Set sh2 = Sheets("Upload Tab")
    Last = sh1.Cells(Rows.Count, "C").End(xlUp).Row
    ''
    'Filter rows based on Name which is in column 3
    sh1.Range("A1:C" & Last).AutoFilter
    sh1.Range("A1:C" & Last).AutoFilter Field:=3, Criteria1:=sName
    ''
    'Copy filtered table and paste it in Destination cell.
    sh1.Range("A2:C" & Last).SpecialCells(xlCellTypeVisible).Copy
    sh2.Range("B4").PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    ''
    'Remove filter that was applied.
    ActiveSheet.AutoFilterMode = False
    ''
    End Sub

Trying to copy the "Blue" filtered data to my upload tab range but got runtime error 1004 at this line. sh1.Range("A2:C" & Last).SpecialCells(xlCellTypeVisible).Copy Thanks.

My goal is to try to filter by specific critieria, copy and paste to designated area. Screen prints for reference. thanks.

 

[mrshl9898]

Is there anything to copy? You're filtering on sName but that's not a Variable.

 

[Logit]

This works with the word Blue in Col C :

Option Explicit

 Sub CopyFilteredData()
    Dim sName1 As String
    Dim sName2 As String
    Dim sName3 As String
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim Last As Long
    
    ''
    ''
    sName1 = "Blue"
    sName2 = "Red"
    sName3 = "white"
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    Last = sh1.Cells(Rows.Count, "C").End(xlUp).Row
    ''
    'Filter rows based on Name which is in column 3
    sh1.Range("A1:C" & Last).AutoFilter
    sh1.Range("A1:C" & Last).AutoFilter Field:=3, Criteria1:=sName1
    ''
    'Copy filtered table and paste it in Destination cell.
    sh1.Range("A2:C" & Last).SpecialCells(xlCellTypeVisible).Copy
    sh2.Range("B4").PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    ''
    'Remove filter that was applied.
    ActiveSheet.AutoFilterMode = False
    ''
    End Sub

For Criteria I specified sName1.

You could add an Input Box to inquire from the User which color, then use than answer in Criteria1

 

[Michael M]

Maybe this way....

Sub CopyFilteredData()
Dim sh1 As Worksheet, sh2 As Worksheet, Last As Long, last2 As Long
Dim items As Variant, item As Variant
items = Array("Blue", "Red", "White")
    Set sh1 = Sheets("Data Tab")
    Set sh2 = Sheets("Upload Tab")
    Last = sh1.Cells(Rows.Count, "C").End(xlUp).Row
    last2 = sh2.Cells(Rows.Count, "B").End(xlUp).Row + 2
    sh1.Range("A1:C" & Last).AutoFilter
For Each item In items
    sh1.Range("A1:C" & Last).AutoFilter Field:=3, Criteria1:=item
    'Copy filtered table and paste it in Destination cell.
    sh1.Range("A2:C" & Last).SpecialCells(xlCellTypeVisible).Copy
    sh2.Range("B" & last2).PasteSpecial Paste:=xlPasteAll
    last2 = sh2.Cells(Rows.Count, "B").End(xlUp).Row + 2
    sh1.AutoFilterMode = False
Next item
Application.CutCopyMode = False
End Sub

 

[outlawdevil]

This works with the word Blue in Col C :

Option Explicit

Sub CopyFilteredData()
    Dim sName1 As String
    Dim sName2 As String
    Dim sName3 As String
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim Last As Long
   
    ''
    ''
    sName1 = "Blue"
    sName2 = "Red"
    sName3 = "white"
    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    Last = sh1.Cells(Rows.Count, "C").End(xlUp).Row
    ''
    'Filter rows based on Name which is in column 3
    sh1.Range("A1:C" & Last).AutoFilter
    sh1.Range("A1:C" & Last).AutoFilter Field:=3, Criteria1:=sName1
    ''
    'Copy filtered table and paste it in Destination cell.
    sh1.Range("A2:C" & Last).SpecialCells(xlCellTypeVisible).Copy
    sh2.Range("B4").PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    ''
    'Remove filter that was applied.
    ActiveSheet.AutoFilterMode = False
    ''
    End Sub

For Criteria I specified sName1.

You could add an Input Box to inquire from the User which color, then use than answer in Criteria1

yea I got error on that line now. So sName1="Blue" doesn't mean the filter pick the "Blue" selection? how would I fix this if I want to manually loop thru Blue first? thanks.

 

[outlawdevil]

Maybe this way....

Sub CopyFilteredData()
    Dim sName1 As String, sName2 As String, sName3 As String, n As Integer
    Dim sh1 As Worksheet, sh2 As Worksheet, Last As Long, last2 As Long
Dim items As Variant, item As Variant
items = Array("Blue", "Red", "White")
    Set sh1 = Sheets("Data Tab")
    Set sh2 = Sheets("Upload Tab")
    Last = sh1.Cells(Rows.Count, "C").End(xlUp).Row
    last2 = sh2.Cells(Rows.Count, "B").End(xlUp).Row + 2
    sh1.Range("A1:C" & Last).AutoFilter
For Each item In items
    sh1.Range("A1:C" & Last).AutoFilter Field:=3, Criteria1:=item
    'Copy filtered table and paste it in Destination cell.
    sh1.Range("A2:C" & Last).SpecialCells(xlCellTypeVisible).Copy
    sh2.Range("B" & last2).PasteSpecial Paste:=xlPasteAll
    last2 = sh2.Cells(Rows.Count, "B").End(xlUp).Row + 2
    sh1.AutoFilterMode = False
Next item
Application.CutCopyMode = False
End Sub

the problem with this code is I can't dictate where I want to copy each range section. I want Blue range to paste starting B4, Red to B114 and white 224.

 

[Michael M]

The problem is, you didn't tell us that in the first instance.....and your screenshoots don't show any row numbers !
This way then

Sub CopyFilteredData()
    Dim sh1 As Worksheet, sh2 As Worksheet, Last As Long, last2 As Long
Dim items As Variant, item As Variant
items = Array("Blue", "Red", "White")
    Set sh1 = Sheets("Data Tab")
    Set sh2 = Sheets("Upload Tab")
    Last = sh1.Cells(Rows.Count, "C").End(xlUp).Row
    last2 = sh2.Range("B4").Row
    sh1.Range("A1:C" & Last).AutoFilter
For Each item In items
    sh1.Range("A1:C" & Last).AutoFilter Field:=3, Criteria1:=item
    'Copy filtered table and paste it in Destination cell.
    sh1.Range("A2:C" & Last).SpecialCells(xlCellTypeVisible).Copy
    sh2.Range("B" & last2).PasteSpecial Paste:=xlPasteAll
    last2 = last2 + 110
    
    sh1.AutoFilterMode = False
Next item
Application.CutCopyMode = False
    End Sub

 

[outlawdevil]

The problem is, you didn't tell us that in the first instance.....and your screenshoots don't show any row numbers !
This way then

Sub CopyFilteredData()
    Dim sh1 As Worksheet, sh2 As Worksheet, Last As Long, last2 As Long
Dim items As Variant, item As Variant
items = Array("Blue", "Red", "White")
    Set sh1 = Sheets("Data Tab")
    Set sh2 = Sheets("Upload Tab")
    Last = sh1.Cells(Rows.Count, "C").End(xlUp).Row
    last2 = sh2.Range("B4").Row
    sh1.Range("A1:C" & Last).AutoFilter
For Each item In items
    sh1.Range("A1:C" & Last).AutoFilter Field:=3, Criteria1:=item
    'Copy filtered table and paste it in Destination cell.
    sh1.Range("A2:C" & Last).SpecialCells(xlCellTypeVisible).Copy
    sh2.Range("B" & last2).PasteSpecial Paste:=xlPasteAll
    last2 = last2 + 110
   
    sh1.AutoFilterMode = False
Next item
Application.CutCopyMode = False
    End Sub[/
[/QUOTE]

 

[Michael M]

Bit shorter

Sub CopyFilteredData()
    Dim sh1 As Worksheet, sh2 As Worksheet, Last As Long, last2 As Long
Dim items As Variant, item As Variant
items = Array("Blue", "Red", "White")
    Set sh1 = Sheets("Data Tab")
    Set sh2 = Sheets("Upload Tab")
    Last = sh1.Cells(Rows.Count, "C").End(xlUp).Row
    last2 = sh2.Range("B4").Row
For Each item In items
    sh1.Range("A1:C" & Last).AutoFilter Field:=3, Criteria1:=item
    sh1.Range("A2:C" & Last).SpecialCells(xlCellTypeVisible).Copy sh2.Range("B" & last2)
    last2 = last2 + 110
    sh1.AutoFilterMode = False
Next item
Application.CutCopyMode = False
 End Sub

 

[outlawdevil]

Yes, this works now. Thank you so much! Sorry about the screenshot was missing the row number. I got a question, will I be able to modify if I add more color to the item arrays and maybe other color will only need 50 rows in the future? so keeping 110 and then 50 for others.