We help IT Professionals succeed at work.

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.

175 Views
Last Modified: 2017-03-06
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?
Comment
Watch Question

CERTIFIED EXPERT

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 Desk
Top Expert 2016

Author

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 Analyst
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION
ShumsManaging Director/Excel VBA Developer
CERTIFIED EXPERT
Distinguished Expert 2018

Commented:
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 Desk
Top Expert 2016

Author

Commented:
@Shums, I got an error on line 19.

Worksheet.Add After:=SrcWs
ShumsManaging Director/Excel VBA Developer
CERTIFIED EXPERT
Distinguished Expert 2018

Commented:
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

Managing Director/Excel VBA Developer
CERTIFIED EXPERT
Distinguished Expert 2018
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION
Edward PamiasTeam Lead RRS Desk
Top Expert 2016

Author

Commented:
Thanks guys. I will be adding on to this Macro today. Thanks for the help!
ShumsManaging Director/Excel VBA Developer
CERTIFIED EXPERT
Distinguished Expert 2018

Commented:
You're Welcome Edward! Glad I was able to help :)
Roy CoxGroup Finance Manager
CERTIFIED EXPERT

Commented:
There is no need to Activate or Select ranges