Hi
I have some data in one sheet. I have some code that examines a specific column for specific strings; if the string is found then the data is cut to a new sheet. I have been testing this and it has been fine - or at least i thought it had.
A user has come back and explained that only 'some' of the matches strings are being cut to the relevant sheet - and sure enough they are right.
I have no idea why! Can anyone help?
Sub secondsortAberdeen()
'Look at each (new) workbook in turn and separate out by warranty code
Dim LSearchRow As Integer
Dim LCutToRow As Integer
'Aberdeen Workbook
Windows("Aberdeen.xls").Activate
Sheets("Sheet1").Select
Cells.Select
Range("A3").Activate
'Start search in row 4
LSearchRow = 4
'Start cuting data to row 4 in selected worksheet (row counter variable)
LCutToRow = 4
While Len(Range("B" & CStr(LSearchRow)).Value) > 0
'Ford Warranty
'If value in column B contains "WARR16 or WARR 02" cut entire row to Ford Warranty sheet
If Range("B" & CStr(LSearchRow)).Value Like "WARR16*" Or Range("B" & CStr(LSearchRow)).Value Like "WARR02*" Then
'Select row in Sheet1 to cut
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Cut
'Paste row into Ford Warranty sheet in next row
Sheets("Ford Warranty").Select
Rows(CStr(LCutToRow) & ":" & CStr(LCutToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCutToRow = LCutToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
LSearchRow = LSearchRow + 1
Wend
GoTo IvecoWarr
IvecoWarr:
'Start search in row 4
LSearchRow = 4
'Start cuting data to row 4 in selected worksheet (row counter variable)
LCutToRow = 4
While Len(Range("B" & CStr(LSearchRow)).Value) > 0
'Iveco Warranty
'If value in column B contains "WARR04", WARR06 or WARR01 cut entire row to 'Iveco Warranty' sheet
If Range("B" & CStr(LSearchRow)).Value Like "WARR04*" Or Range("B" & CStr(LSearchRow)).Value Like "WARR01*" Or Range("B" & CStr(LSearchRow)).Value Like "WARR06*" Then
'Select row in Sheet1 to cut
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Cut
'Paste row into Iveco Warranty sheet in next row
Sheets("Iveco Warranty").Select
Rows(CStr(LCutToRow) & ":" & CStr(LCutToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCutToRow = LCutToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
LSearchRow = LSearchRow + 1
Wend
GoTo IsuzuTruckWarr
IsuzuTruckWarr:
'Start search in row 4
LSearchRow = 4
'Start cuting data to row 4 in selected worksheet (row counter variable)
LCutToRow = 4
While Len(Range("B" & CStr(LSearchRow)).Value) > 0
'Isuzu Truck Warr
'If value in column B contains "WARR05,03,07,08,09,11" cut entire row to 'Isuzu Truck Warranty' sheet
If Range("B" & CStr(LSearchRow)).Value Like "WARR05*" Or Range("B" & CStr(LSearchRow)).Value Like "WARR03*" Or Range("B" & CStr(LSearchRow)).Value Like "WARR07*" Or Range("B" & CStr(LSearchRow)).Value Like "WARR08*" Or Range("B" & CStr(LSearchRow)).Value Like "WARR09*" Or Range("B" & CStr(LSearchRow)).Value Like "WARR11*" Then
'Select row in Sheet1 to cut
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Cut
'Paste row into Isuzu Truck Warranty sheet in next row
Sheets("Isuzu Truck Warranty").Select
Rows(CStr(LCutToRow) & ":" & CStr(LCutToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCutToRow = LCutToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
LSearchRow = LSearchRow + 1
Wend
GoTo Isuzu4WD
Isuzu4WD:
'Start search in row 4
LSearchRow = 4
'Start cuting data to row 4 in selected worksheet (row counter variable)
LCutToRow = 4
While Len(Range("B" & CStr(LSearchRow)).Value) > 0
'Isuzu 4WD
'If value in column B contains "WARR13,14,15" cut entire row to 'Isuzu 4WD sheet
If Range("B" & CStr(LSearchRow)).Value Like "WARR13*" Or Range("B" & CStr(LSearchRow)).Value Like "WARR14*" Or Range("B" & CStr(LSearchRow)).Value Like "WARR15*" Then
'Select row in Sheet1 to cut
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Cut
'Paste row into Isuzu sheet in next row
Sheets("Isuzu 4WD").Select
Rows(CStr(LCutToRow) & ":" & CStr(LCutToRow)).Select
ActiveSheet.Paste
'Move counter to next row
LCutToRow = LCutToRow + 1
'Go back to Sheet1 to continue searching
Sheets("Sheet1").Select
End If
LSearchRow = LSearchRow + 1
Wend
Sheets("Sheet1").Select
End Sub
Bookmarks