VBA - Help with Copy/Paste/Filter

ExcelMercy

ExcelMercy

Board Regular
Joined
Aug 11, 2014
Messages
151
Hey All,


Having a bit of an issue, can't seem to get the filter to correctly.. uh, filter! Any help would be greatly appreciated!




Here is the code:
Code: 
Sub Market_Confirm_Test()
    'Switch to Market Totals Tab
        Sheets("Market_Totals").Select
 
Dim ws11     As Worksheet
Dim ws12     As Worksheet
Dim x       As Long
Dim y       As Long
Dim i       As Long
Dim arr()   As Variant
Const SystemCode As String = "AP_123_Lo_4 AP_123_Lo_6 JF_123_Lo_1_SYS JF_123_Lo_2 HG_123_Lo_2_SYS"
    Application.ScreenUpdating = False
    Set ws11 = ActiveSheet
    Set ws12 = Worksheets.Add
    With ws12
        .Name = "Market_Confirm"
        .Move after:=Sheets(Sheets.Count)
        x = 1
        For Each Var In Array("System Code", "First Name", "Last Name", "Address 1", "City", "State", "Market ID")
            .Cells(1, x).Value = CStr(Var)
            x = x + 1
        Next Var
    End With
    With ws11
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Range("D" & .Rows.Count).End(xlUp).Row
        y = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        arr = .Range("D2:D" & x).Value
 
        .Cells(1, y).Value = "Filter row"
        For i = LBound(arr, 1) To UBound(arr, 1)
            If InStr(SystemCode, CStr(arr(i, 1))) Then
                arr(i, 1) = True
            Else
                arr(i, 1) = False
            End If
        Next i
        .Cells(2, y).Resize(UBound(arr, 1)).Value = arr
        .Cells(1, y).Resize(x).AutoFilter Field:=1, Criteria1:=False
        .Range("D2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
        ws12.Range("A2").PasteSpecial xlPasteAll
        .Range("F2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
        ws12.Range("B2").PasteSpecial xlPasteAll
        .Range("H2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
        ws12.Range("C2").PasteSpecial xlPasteAll
        .Range("I2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
        ws12.Range("D2").PasteSpecial xlPasteAll
        .Range("K2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
        ws12.Range("E2").PasteSpecial xlPasteAll
        .Range("L2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
        ws12.Range("F2").PasteSpecial xlPasteAll
        .Range("B2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
        ws12.Range("G2").PasteSpecial xlPasteAll
        Application.CutCopyMode = False
        .Cells(1, y).Resize(x).Clear
    End With
    Application.ScreenUpdating = True
    Set ws11 = Nothing
    Set ws12 = Nothing
    Erase arr
End Sub

Starting Sheet (Market_Totals)
[TABLE="width: 1085"]
<tbody>[TR]
[TD]Type
[/TD]
[TD]Market ID
[/TD]
[TD]Order by
[/TD]
[TD]System Code
[/TD]
[TD]Name id
[/TD]
[TD]First Name
[/TD]
[TD]Middle Initial
[/TD]
[TD]Last Name
[/TD]
[TD]Address 1
[/TD]
[TD]Address 2
[/TD]
[TD]City
[/TD]
[TD]State
[/TD]
[TD]Postal code
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]213546
[/TD]
[TD]*
[/TD]
[TD]AP_123_Lo_4
[/TD]
[TD]75473d
[/TD]
[TD]Billy
[/TD]
[TD]C
[/TD]
[TD]Smith
[/TD]
[TD]111 N Street
[/TD]
[TD][/TD]
[TD]Philadelphia
[/TD]
[TD]PA
[/TD]
[TD]12345
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]432452
[/TD]
[TD]*
[/TD]
[TD]AP_123_Lo_5
[/TD]
[TD]756859d
[/TD]
[TD]Jacob
[/TD]
[TD][/TD]
[TD]Johnson
[/TD]
[TD]123 S Street
[/TD]
[TD][/TD]
[TD]New Orleans
[/TD]
[TD]LA
[/TD]
[TD]84001
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]3425267
[/TD]
[TD]*
[/TD]
[TD]AP_123_Lo_6
[/TD]
[TD]7646d
[/TD]
[TD]Sue
[/TD]
[TD][/TD]
[TD]Doe
[/TD]
[TD]123 Main St
[/TD]
[TD][/TD]
[TD]Atlanta
[/TD]
[TD]GA
[/TD]
[TD]65431
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]8798567
[/TD]
[TD]*
[/TD]
[TD]AP_123_Lo_7
[/TD]
[TD]435322fg
[/TD]
[TD]Becky
[/TD]
[TD]A
[/TD]
[TD]Smith
[/TD]
[TD]123 NorthWest Main Rd
[/TD]
[TD][/TD]
[TD]Nashville
[/TD]
[TD]TN
[/TD]
[TD]45678
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]679732542
[/TD]
[TD]*
[/TD]
[TD]AP_123_Lo_8
[/TD]
[TD]4325253fg
[/TD]
[TD]Stacy
[/TD]
[TD][/TD]
[TD]Marshall
[/TD]
[TD]9483 Walkway Dr
[/TD]
[TD][/TD]
[TD]Houston
[/TD]
[TD]TX
[/TD]
[TD]54634
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]3242368
[/TD]
[TD]*
[/TD]
[TD]JF_123_Lo_1_SYS
[/TD]
[TD]23215fg
[/TD]
[TD]Larence
[/TD]
[TD]S
[/TD]
[TD]Donald
[/TD]
[TD]2143 Systems Avn
[/TD]
[TD][/TD]
[TD]New Orleans
[/TD]
[TD]LA
[/TD]
[TD]84001
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]6775674
[/TD]
[TD]*
[/TD]
[TD]JF_123_Lo_2
[/TD]
[TD]64345d
[/TD]
[TD]Kimberly
[/TD]
[TD][/TD]
[TD]Jones
[/TD]
[TD]123 Timber Rd
[/TD]
[TD][/TD]
[TD]Nashville
[/TD]
[TD]TN
[/TD]
[TD]54001
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]53424567
[/TD]
[TD]*
[/TD]
[TD]JF_123_Lo_2
[/TD]
[TD]6788900d
[/TD]
[TD]Mike
[/TD]
[TD]G
[/TD]
[TD]Gareld
[/TD]
[TD]136 South rd
[/TD]
[TD][/TD]
[TD]Philadelphia
[/TD]
[TD]PA
[/TD]
[TD]45201
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]8798567
[/TD]
[TD]*
[/TD]
[TD]HG_123_Lo_1_SYS
[/TD]
[TD]6422fg
[/TD]
[TD]Becky
[/TD]
[TD]A
[/TD]
[TD]Smith
[/TD]
[TD]788 Landing Rd
[/TD]
[TD][/TD]
[TD]Nashville
[/TD]
[TD]TN
[/TD]
[TD]45678
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]679732542
[/TD]
[TD]*
[/TD]
[TD]HG_123_Lo_1_SYS
[/TD]
[TD]6233fg
[/TD]
[TD]Stacy
[/TD]
[TD][/TD]
[TD]Marshall
[/TD]
[TD]3 Moore Dr
[/TD]
[TD][/TD]
[TD]Philadelphia
[/TD]
[TD]PA
[/TD]
[TD]85201
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]3242368
[/TD]
[TD]*
[/TD]
[TD]HG_123_Lo_1_SYS
[/TD]
[TD]5234fg
[/TD]
[TD]Larence
[/TD]
[TD]S
[/TD]
[TD]Donald
[/TD]
[TD]212 Lake Drive
[/TD]
[TD][/TD]
[TD]Philadelphia
[/TD]
[TD]PA
[/TD]
[TD]95201
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]6775674
[/TD]
[TD]*
[/TD]
[TD]HG_123_Lo_2_SYS
[/TD]
[TD]3125d
[/TD]
[TD]Kimberly
[/TD]
[TD][/TD]
[TD]Jones
[/TD]
[TD]1677 Trees Rd
[/TD]
[TD][/TD]
[TD]New Orleans
[/TD]
[TD]LA
[/TD]
[TD]84001
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]53424567
[/TD]
[TD]*
[/TD]
[TD]HG_123_Lo_2_SYS
[/TD]
[TD]432656d
[/TD]
[TD]Mike
[/TD]
[TD]G
[/TD]
[TD]Gareld
[/TD]
[TD]13455 Northsouth Rd
[/TD]
[TD][/TD]
[TD]Philadelphia
[/TD]
[TD]PA
[/TD]
[TD]65201
[/TD]
[/TR]
</tbody>[/TABLE]





Output I want:
[TABLE="width: 509"]
<tbody>[TR]
[TD]System Code
[/TD]
[TD]First Name
[/TD]
[TD]Last Name
[/TD]
[TD]Address 1
[/TD]
[TD]City
[/TD]
[TD]State
[/TD]
[TD]Market ID
[/TD]
[/TR]
[TR]
[TD]AP_123_Lo_4
[/TD]
[TD]Billy
[/TD]
[TD]Smith
[/TD]
[TD]111 N Street
[/TD]
[TD]Philadelphia
[/TD]
[TD]PA
[/TD]
[TD]213546
[/TD]
[/TR]
[TR]
[TD]AP_123_Lo_6
[/TD]
[TD]Jacob
[/TD]
[TD]Johnson
[/TD]
[TD]123 S Street
[/TD]
[TD]New Orleans
[/TD]
[TD]LA
[/TD]
[TD]432452
[/TD]
[/TR]
[TR]
[TD]JF_123_Lo_1_SYS
[/TD]
[TD]Larence
[/TD]
[TD]Donald
[/TD]
[TD]2143 Systems Avn
[/TD]
[TD]New Orleans
[/TD]
[TD]LA
[/TD]
[TD]3242368
[/TD]
[/TR]
[TR]
[TD]JF_123_Lo_2
[/TD]
[TD]Kimberly
[/TD]
[TD]Jones
[/TD]
[TD]123 Timber Rd
[/TD]
[TD]Nashville
[/TD]
[TD]TN
[/TD]
[TD]6775674
[/TD]
[/TR]
[TR]
[TD]HG_123_Lo_2_SYS
[/TD]
[TD]Kimberly
[/TD]
[TD]Jones
[/TD]
[TD]1677 Trees Rd
[/TD]
[TD]New Orleans
[/TD]
[TD]LA
[/TD]
[TD]6775674
[/TD]
[/TR]
[TR]
[TD]HG_123_Lo_2_SYS
[/TD]
[TD]Mike
[/TD]
[TD]Gareld
[/TD]
[TD]13455 Northsouth Rd
[/TD]
[TD]Philadelphia
[/TD]
[TD]PA
[/TD]
[TD]53424567
[/TD]
[/TR]
</tbody>[/TABLE]




Output I'm getting:

[TABLE="width: 509"]
<tbody>[TR]
[TD="align: left"]System Code
[/TD]
[TD="align: left"]First Name
[/TD]
[TD="align: left"]Last Name
[/TD]
[TD="align: left"]Address 1
[/TD]
[TD="align: left"]City
[/TD]
[TD="align: left"]State
[/TD]
[TD="align: left"]Market ID
[/TD]
[/TR]
[TR]
[TD]AP_123_Lo_5
[/TD]
[TD]Jacob
[/TD]
[TD]Johnson
[/TD]
[TD]123 S Street
[/TD]
[TD]New Orleans
[/TD]
[TD]LA
[/TD]
[TD]432452
[/TD]
[/TR]
[TR]
[TD]AP_123_Lo_7
[/TD]
[TD]Becky
[/TD]
[TD]Smith
[/TD]
[TD]123 NorthWest Main Rd
[/TD]
[TD]Nashville
[/TD]
[TD]TN
[/TD]
[TD]8798567
[/TD]
[/TR]
[TR]
[TD]AP_123_Lo_8
[/TD]
[TD]Stacy
[/TD]
[TD]Marshall
[/TD]
[TD]9483 Walkway Dr
[/TD]
[TD]Houston
[/TD]
[TD]TX
[/TD]
[TD]6.8E+08
[/TD]
[/TR]
[TR]
[TD]HG_123_Lo_1_SYS
[/TD]
[TD]Becky
[/TD]
[TD]Smith
[/TD]
[TD]788 Landing Rd
[/TD]
[TD]Nashville
[/TD]
[TD]TN
[/TD]
[TD]8798567
[/TD]
[/TR]
[TR]
[TD]HG_123_Lo_1_SYS
[/TD]
[TD]Stacy
[/TD]
[TD]Marshall
[/TD]
[TD]3 Moore Dr
[/TD]
[TD]Philadelphia
[/TD]
[TD]PA
[/TD]
[TD]6.8E+08
[/TD]
[/TR]
[TR]
[TD]HG_123_Lo_1_SYS
[/TD]
[TD]Larence
[/TD]
[TD]Donald
[/TD]
[TD]212 Lake Drive
[/TD]
[TD]Philadelphia
[/TD]
[TD]PA
[/TD]
[TD]3242368
[/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
That's strange. It is still working for me.

You will have to make sure that the sheet called Market_Confirm has been deleted, though. But that is as it was before.

Here is a version that makes sure the Market_Confirm worksheet is removed prior to starting. I think I got it right this time.
Code: 
Sub Market_Confirm_Test()
    
    Dim ws11       As Worksheet
    Dim ws12       As Worksheet
    Dim x          As Long
    Dim y          As Long
    Dim SystemCode As Variant
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("Market_Confirm").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set ws11 = ThisWorkbook.Worksheets("Market_Totals")
    Set ws12 = Worksheets.Add
    
    SystemCode = Array("AP_123_Lo_4", "AP_123_Lo_6", "JF_123_Lo_1_SYS", "JF_123_Lo_2", "HG_123_Lo_2_SYS")

    With ws12
        .Name = "Market_Confirm"
        .Move after:=Sheets(Sheets.Count)
        .Range("A1").Resize(1, 7).Value = Array("System Code", "First Name", "Last Name", "Address 1", "City", "State", "Market ID")
    End With
    
    With ws11
        If .AutoFilterMode Then .AutoFilterMode = False
        x = .Range("D" & .Rows.Count).End(xlUp).Row
        y = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1

         .Cells(1, "D").Resize(x).AutoFilter Field:=1, Criteria1:=SystemCode, Operator:=xlFilterValues
        If .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
            .Range("D2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("A2").PasteSpecial xlPasteAll
            .Range("F2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("B2").PasteSpecial xlPasteAll
            .Range("H2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("C2").PasteSpecial xlPasteAll
            .Range("I2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("D2").PasteSpecial xlPasteAll
            .Range("K2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("E2").PasteSpecial xlPasteAll
            .Range("L2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("F2").PasteSpecial xlPasteAll
            .Range("B2").Resize(x - 1).SpecialCells(xlCellTypeVisible).Copy
            ws12.Range("G2").PasteSpecial xlPasteAll
        End If
    End With
    
    Application.ScreenUpdating = True
    Set ws11 = Nothing
    Set ws12 = Nothing

End Sub
 
Upvote 0

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Would it possible to add like an IF around the entire thing.


Like, don't even make Market_Confirm if ("AP_123_Lo_4", "AP_123_Lo_6", "JF_123_Lo_1_SYS", "JF_123_Lo_2", "HG_123_Lo_2_SYS") isn't found on Market_Totals?
 
Upvote 0
You must log in or register to reply here.

Similar threads

ExcelMercy
  • Question Question
VBA - Subscript out of range
Replies
3
Views
1K
Andrew Poulsom
Andrew Poulsom
ExcelMercy
  • Question Question
VBA - If Question
Replies
1
Views
433
Jerry Sullivan
Jerry Sullivan
ExcelMercy
  • Question Question
VBA - Color Row with If
Replies
7
Views
1K
V_Malkoti
V_Malkoti
S
  • Question Question
VBA to automatically filter table based on list
Replies
0
Views
638
shap
S

Forum statistics

Threads
1,224,975
Messages
6,182,112
Members
453,089
Latest member
boonga

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