Okay, so I'm trying to build a code that will copy specific rows based on a cell value in that row, and after pasting to a separate spreadsheet, delete those rows. I was looking at this code for inspiration, but admittedly I am not very good in VBA and am having no luck
any suggestions?
Thanks!
Code:
Option Explicit
[B]Sub FastestAndMostFlexible()[/B]
[COLOR=#008000]''''''''''''''''''''''''''
'Written by www.ozgrid.com
''''''''''''''''''''''''''[/COLOR]
Dim rRange As Range
Dim strCriteria As String
Dim lCol As Long
Dim rHeaderCol As Range
Dim xlCalc As XlCalculation
Const strTitle As String = "OZGRID CONDITIONAL ROW DELETE"
On Error Resume Next
Step1:
[COLOR=#008000]'We use Application.InputBox type 8 so user can select range[/COLOR]
Set rRange = Application.InputBox(Prompt:="Select range including header range" _
, Title:=strTitle & " STEP 1 of 3", Default:=ActiveCell.CurrentRegion.Address, Type:=8)
[COLOR=#008000]'Cancelled or non valid rage[/COLOR]
If rRange Is Nothing Then Exit Sub
[COLOR=#008000]'Awlays use GoTo when selecting range so doesn't matter which Worksheet[/COLOR]
Application.Goto rRange.Rows(1), True
Step2
[COLOR=#008000]'We use Application.InputBox type 1 so return a number[/COLOR]
lCol = Application.InputBox(Prompt:="Please enter relative column number of evaluation column" _
, Title:=strTitle & " STEP 2 of 3", Default:=1, Type:=1)
[COLOR=#008000]'Cancelled[/COLOR]
If lCol = 0 Then Exit Sub
Step3:
[COLOR=#008000]'We use default InputBox type as we want Text[/COLOR]
strCriteria = InputBox(Prompt:="Please enter a single criteria." & _
vbNewLine & "Eg >5 OR <10 OR Cat* OR *Cat OR *Cat*" _
, Title:=strTitle & " STEP 3 of 3")
If strCriteria = vbNullString Then Exit Sub
[COLOR=#008000] 'Store current Calculation then switch to manual.
'Turn off events and screen updating[/COLOR]
With Application
xlCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
[COLOR=#008000]'Remove any filters[/COLOR]
ActiveSheet.AutoFilterMode = False
With rRange [COLOR=#008000]'Filter, offset(to exclude headers) and delete visible rows[/COLOR]
.AutoFilter Field:=lCol, Criteria1:=strCriteria
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
[COLOR=#008000]'Remove any filters[/COLOR]
ActiveSheet.AutoFilterMode = False
'Revert back
With Application
.Calculation = xlCalc
.EnableEvents = True
.ScreenUpdating = True
End With
On Error GoTo 0
[B]End Sub[/B]
</pre>
any suggestions?
Thanks!