Avatar of Cook09
Cook09
Flag for United States of America asked on

VBA If statement with filtered values

Attached is a spreadsheet which has filtered values in sheet Table1.  In trying to write some code that would put the word "Inbound" in one Cell and the three Outbound words in other cells, the code keeps throwing an error.

How can the code be written to place any visible text value, from a filtered table, into a cell and then place a second text value text value into a separate cell.
Cook09
Filter_Copy.xlsm
Microsoft OfficeVBAMicrosoft ExcelSpreadsheets

Avatar of undefined
Last Comment
Shums Faruk

8/22/2022 - Mon
Shums Faruk

Hi Cook09,

Please use below code:
Sub CopyFilteredRow()
Dim SrcWs As Worksheet, DestSh As Worksheet
Dim SrcLR As Long
Dim CritRng As Range
Dim InBnd As String, OutBnd As String
Dim c As Range, ar As Range
Dim DestRow As Long
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Set SrcWs = Worksheets("Table1")
Set DestSh = Worksheets("Main")
SrcLR = SrcWs.Range("A" & Rows.Count).End(xlUp).Row
DestSh.Range("A4:G100").ClearContents
DestSh.Range("A1").ClearContents
SrcWs.Range("B2", SrcWs.Cells(SrcWs.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Copy
DestSh.Range("A1").PasteSpecial xlPasteValues
InBnd = "INBOUND"
OutBnd = "OUTBOUND"
DestRow = 4
Set CritRng = SrcWs.Range("N2:N" & SrcLR).SpecialCells(xlCellTypeVisible)
For Each ar In CritRng.Areas
    For Each c In ar
        If c.Value = InBnd Then
            SrcWs.Range("A" & c.Row).Copy
            DestSh.Range("A" & DestRow).PasteSpecial xlPasteValues
            SrcWs.Range("C" & c.Row).Copy
            DestSh.Range("B" & DestRow).PasteSpecial xlPasteValues
            SrcWs.Range("F" & c.Row).Copy
            DestSh.Range("C" & DestRow).PasteSpecial xlPasteValues
            DestRow = DestRow + 1
        ElseIf c.Value = OutBnd Then
            SrcWs.Range("A" & c.Row).Copy
            DestSh.Range("E" & DestRow).PasteSpecial xlPasteValues
            SrcWs.Range("C" & c.Row).Copy
            DestSh.Range("F" & DestRow).PasteSpecial xlPasteValues
            SrcWs.Range("F" & c.Row).Copy
            DestSh.Range("G" & DestRow).PasteSpecial xlPasteValues
            DestRow = DestRow + 1
        End If
    Next c
Next ar

Application.CutCopyMode = False
DestSh.Activate
DestSh.Columns.AutoFit
DestSh.Range("A4").Select
ActiveWindow.FreezePanes = True
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

Please find attached...
Filter_Copy_v1.xlsm
ASKER CERTIFIED SOLUTION
Shums Faruk

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Cook09

ASKER
Excellent!!!!
Both the Pivot and the VBA are exactly what I needed.  Not sure why there was an issue with the xlCellTypeVisible, but what you put together does work.  Thanks for the Pivot...need to begin using this more.  May have saved quite a bit of time.

Wish I could allot more points for two solutions...but....
Shums Faruk

hehehe. Thanks Cook for such comments.

You're always welcome! Glad I was able to provide solution as you expected.
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck