While, Wends, Ifs and Ors with unexpected behaviors

**virgincinboy** · 05-01-2013, 05:08 AM

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

**TMS** · 05-01-2013, 05:16 AM

When you are deleting or cutting rows, you need to start at the bottom so that, when you remove a row it doesn't screw up Excel's internal position.

Determine the last row of data and then work up from there (step -1) in your loop.

Regards, TMS

**snb** · 05-01-2013, 05:19 AM

Avoid 'activate' and 'Select' in VBA.

In Office2000 the while...wend has been replaced by the more flexible Do...Loop. You can choose where to introduce the while/until condition.

This code will probably produce the same results:

with workbooks("Aberdeen.xls").Sheets("Sheet1").cells(1).currentregion
     .autofilter 2 ,"WARR16",xlor,"WARR02"
     .offset(1).cut Sheets("Isuzu 4WD").cells(4,1)
     .autofilter
  end with

**ragulduy** · 05-01-2013, 05:22 AM

Hard to know exactly without having a copy of the workbook but my guess would be that you cut the row if you find the data and then still incrememnt the counter, so if you had 3 rows:
1 Warr016
2 Warr02
3 Warr016
When Row 1 is cut, it would become
1 Warr02
2 Warr016
And your counter would be at row 2, so the Warr02 term would be skipped

So instead of

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

You need

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
         
      Else
      
      LSearchRow = LSearchRow + 1

      End if

**virgincinboy** · 05-01-2013, 06:06 AM

Thanks to all for suggestions.

TM Shucks - i think that is the problem (yudlugar said similar) but alas I am not sure how to modify the code to start from the bottom up?

snb - alas I tried your code and was presented with a 'Run Time Error 1004' - AutoFilter method of range class failed - any ides why?

yudlugar - i tried your code too - but it seemed to stop after only checking one row - and i don't know why it did that either! (Can you tell i don't know very much?!)

I attach the sheet in the hope that it makes things easier to debug.

Inverness test.xlsx

I want to look at column B and extract WARR16 and WARR02 to the Ford sheet, WARR01 to Iveco Warranty, WARR11 to Isuzu Truck, and Warr13 to Isuzu 4WD.

Thanks to everyone for help so far.

**snb** · 05-01-2013, 06:13 AM

Why don't you use the first 2 rows ?

**virgincinboy** · 05-01-2013, 06:19 AM

Hi snb - thanks for the reply. This macro is number 7 in a series of 15 that run to achieve a bigger goal - the first 2 rows need to be left as they are at this stage. Thanks

**ragulduy** · 05-01-2013, 06:23 AM

Yeah I'm not sure that is the problem anymore, when I tried it on your worksheet the cut command left the row blank so you still needed to increment the counter. This seems to work on your worksheet:



Sub extract_warranties()
Count = 4
Do Until Range("B" & Count) = ""
    If Range("B" & Count) = "WARR16" Or Range("B" & Count) = "WARR02" Then
        Rows(Count).Cut Sheets("Ford Warranty").Rows(Sheets("Ford Warranty").Cells(65536, 1).End(xlUp).Row + 1)
    ElseIf Range("B" & Count) = "WARR01" Then
        Rows(Count).Cut Sheets("Iveco Warranty").Rows(Sheets("Iveco Warranty").Cells(65536, 1).End(xlUp).Row + 1)
    ElseIf Range("B" & Count) = "WARR11" Then
        Rows(Count).Cut Sheets("Isuzu Truck Warranty").Rows(Sheets("Isuzu Truck Warranty").Cells(65536, 1).End(xlUp).Row + 1)
    ElseIf Range("B" & Count) = "WARR13" Then
        Rows(Count).Cut Sheets("Isuzu 4WD").Rows(Sheets("Isuzu 4WD").Cells(65536, 1).End(xlUp).Row + 1)
    End If
    Count = Count + 1
Loop
End Sub

**Norie** · 05-01-2013, 06:26 AM

What is the bigger goal?

Are all the macros pretty similar?

**virgincinboy** · 05-01-2013, 06:35 AM

Norrie - the bigger goal has been the stuff of my nightmares! All of the macros are sound, except this one - All sorted now though - thanks.

**virgincinboy** · 05-01-2013, 06:33 AM

Yudlugar - that worked a treat! Star already clicked!

Thanks SO much for your (and everyones!) help.

While, Wends, Ifs and Ors with unexpected behaviors

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

While, Wends, Ifs and Ors with unexpected behaviors

Re: While, Wends, Ifs and Ors with unexpected behaviors

Re: While, Wends, Ifs and Ors with unexpected behaviors

Re: While, Wends, Ifs and Ors with unexpected behaviors

Re: While, Wends, Ifs and Ors with unexpected behaviors

Re: While, Wends, Ifs and Ors with unexpected behaviors

Re: While, Wends, Ifs and Ors with unexpected behaviors

Re: While, Wends, Ifs and Ors with unexpected behaviors

Re: While, Wends, Ifs and Ors with unexpected behaviors

Re: While, Wends, Ifs and Ors with unexpected behaviors

Re: While, Wends, Ifs and Ors with unexpected behaviors

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions