Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!
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?
Do more with
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
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.
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.
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.
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
Hi Edward,
Try below:
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
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
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
Premium Content
You need an Expert Office subscription to comment.Start Free Trial