I need an Excel Macro to filter the word "Project" in column H and expand the selection, then copy the results (all columns) to another sheet.

I have a data sheet that ranges from A1 thru K1 on down (data fluctuates daily) I need to Find the word "Project" in column H and exclude that from the sheet and everything in the corresponding rows. Then copy whats left over to a new sheet, Can this be done with VBA?
LVL 19
Edward PamiasTeam Lead RRS DeskAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Wayne Taylor (webtubbs)Commented:
Yes, it can be done with VBA. Easiest way to generate the code is to record a macro while performing the steps you want. At the bottom left in the status bar is a button (to the right of "Ready"). Click that, enter the macro name, click OK, then perform the steps required. When done, click that button again. To view your code, press Alt+F8, select your recorded macro, then click Edit.
Edward PamiasTeam Lead RRS DeskAuthor Commented:
I could do that but since the data fluctuates daily that recorded macro does not work well. It's locked down to the range I have at that time. And I am not a VBA expert to modify such a macro.
RayData AnalystCommented:
Not sure your conditions, but this is at it's simplest form...

Assumes you are already on the sheet to be filtered and copied.  Let us know if you need to know how to add this macro to your workbook.

Sub EEMacro()

    'Add Autofilter (assumes it is not there)
    Range("A1:K1").Select
    Selection.AutoFilter
    
    'filter data to not show anything with "project" (not case sensitive)
    ActiveSheet.Range("$A$1:$K$13").AutoFilter Field:=8, Criteria1:= _
        "<>*project*", Operator:=xlAnd
    
    'Select range, add new sheet, copy filtered results to the range
    Range("A1:K1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    
    Range("A1").Select
End Sub

Open in new window

Ensure Business Longevity with As-A-Service

Using the as-a-service approach for your business model allows you to grow your revenue stream with new practice areas, without forcing you to part ways with existing clients just because they don’t fit the mold of your new service offerings.

Download eBook
ShumsExcel & VBA ExpertCommented:
Hi Edward,

Try below:
Sub CopyFilteredRow()
Dim SrcWs As Worksheet, NewSh As Worksheet
Dim RngFilter As Range
Dim SrcLR As Long
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Set SrcWs = ActiveSheet
SrcLR = SrcWs.Range("A" & Rows.Count).End(xlUp).Row
Set RngFilter = SrcWs.Range("A1:K" & SrcLR)
With RngFilter
    .AutoFilter Field:=8, Criteria1:="<>*Project*"
    .SpecialCells(xlCellTypeVisible).Copy
    Worksheet.Add After:=SrcWs
    ActiveSheet.Paste
End With
ActiveSheet.Name = "FilteredSheet"
Set NewSh = Worksheets("FilteredSheet")
Application.CutCopyMode = False
If SrcWs.AutoFilterMode = True Then SrcWs.AutoFilterMode = False
NewSh.Activate
NewSh.Range("A1").Select
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

Edward PamiasTeam Lead RRS DeskAuthor Commented:
@Shums, I got an error on line 19.

Worksheet.Add After:=SrcWs
ShumsExcel & VBA ExpertCommented:
Try this:
Sub CopyFilteredRow()
Dim SrcWs As Worksheet, NewSh As Worksheet
Dim RngFilter As Range
Dim SrcLR As Long
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Set SrcWs = ActiveSheet
SrcLR = SrcWs.Range("A" & Rows.Count).End(xlUp).Row
Set RngFilter = SrcWs.Range("A1:K" & SrcLR)
With RngFilter
    .AutoFilter Field:=8, Criteria1:="<>*Project*"
    .SpecialCells(xlCellTypeVisible).Copy
    Worksheets.Add.Paste
End With
ActiveSheet.Name = "FilteredSheet"
Set NewSh = Worksheets("FilteredSheet")
Application.CutCopyMode = False
If SrcWs.AutoFilterMode = True Then SrcWs.AutoFilterMode = False
NewSh.Activate
NewSh.Range("A1").Select
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

ShumsExcel & VBA ExpertCommented:
Once copying is done to new sheet then you can add the autofit column at the end.
Sub CopyFilteredRow()
Dim SrcWs As Worksheet, NewSh As Worksheet
Dim RngFilter As Range
Dim SrcLR As Long
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With

Set SrcWs = ActiveSheet
SrcLR = SrcWs.Range("A" & Rows.Count).End(xlUp).Row
Set RngFilter = SrcWs.Range("A1:K" & SrcLR)
With RngFilter
    .AutoFilter Field:=8, Criteria1:="<>*Project*"
    .SpecialCells(xlCellTypeVisible).Copy
    Worksheets.Add.Paste
End With
ActiveSheet.Name = "FilteredSheet"
Set NewSh = Worksheets("FilteredSheet")
Application.CutCopyMode = False
If SrcWs.AutoFilterMode = True Then SrcWs.AutoFilterMode = False
NewSh.Activate
NewSh.Columns.AutoFit
NewSh.Range("A2").Select
ActiveWindow.FreezePanes = True
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Edward PamiasTeam Lead RRS DeskAuthor Commented:
Thanks guys. I will be adding on to this Macro today. Thanks for the help!
ShumsExcel & VBA ExpertCommented:
You're Welcome Edward! Glad I was able to help :)
Roy CoxGroup Finance ManagerCommented:
There is no need to Activate or Select ranges
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.