S
sbitaxi
I have created a macro that searches for instances of "&", then moves
the row to another spreadsheet to separate it from the data that
doesn't (a maintenance task as I prepare the data for conversion to a
new database application).
When the Find runs out of found results, it displays an Error 91. What
I'd like it to ultimately do, is loop through an array of variables,
and move them to another sheet, and End when it no longer finds
results.
Here is my code -
Sub MoveRow()
Dim SourceSh As Worksheet
Dim DestSh As Worksheet
'Dim Fnd As Variant
Dim Last As Long
' Disables screen updating and automatic calculations
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
' Defines values in Array to be found in the Cells.Find
Fnd = Array("&", " or ", " and ")
' Sets the worksheets to be used in the macro
Set SourceSh = ActiveSheet
Worksheets.Add
Set DestSh = ActiveSheet
On Error GoTo 0
For Each thing In Fnd
Do
' Finds data in Array Fnd
Cells.Find(What:=Fnd, After:=ActiveCell, LookIn:=xlFormulas,
LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
' Selects the row containing the found value, cuts/pastes it into the
Destination Sheet (DestSh) after the last row containing data, then
deletes the blank row on the source sheet
Rows(ActiveCell.Row).Select
Selection.Cut
DestSh.Activate
Range("A2").Select
Last = LastRow(DestSh)
Rows(Last + 1).Select
DestSh.Paste
SourceSh.Activate
Selection.Delete
Loop
0 Next
' Restores automatic calculations and screen updating
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With
End Sub
the row to another spreadsheet to separate it from the data that
doesn't (a maintenance task as I prepare the data for conversion to a
new database application).
When the Find runs out of found results, it displays an Error 91. What
I'd like it to ultimately do, is loop through an array of variables,
and move them to another sheet, and End when it no longer finds
results.
Here is my code -
Sub MoveRow()
Dim SourceSh As Worksheet
Dim DestSh As Worksheet
'Dim Fnd As Variant
Dim Last As Long
' Disables screen updating and automatic calculations
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
' Defines values in Array to be found in the Cells.Find
Fnd = Array("&", " or ", " and ")
' Sets the worksheets to be used in the macro
Set SourceSh = ActiveSheet
Worksheets.Add
Set DestSh = ActiveSheet
On Error GoTo 0
For Each thing In Fnd
Do
' Finds data in Array Fnd
Cells.Find(What:=Fnd, After:=ActiveCell, LookIn:=xlFormulas,
LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False _
, SearchFormat:=False).Activate
' Selects the row containing the found value, cuts/pastes it into the
Destination Sheet (DestSh) after the last row containing data, then
deletes the blank row on the source sheet
Rows(ActiveCell.Row).Select
Selection.Cut
DestSh.Activate
Range("A2").Select
Last = LastRow(DestSh)
Rows(Last + 1).Select
DestSh.Paste
SourceSh.Activate
Selection.Delete
Loop
0 Next
' Restores automatic calculations and screen updating
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.StatusBar = False
End With
End Sub