Excel VBA code runs perfectly in Debug Mode if I debug slowly, but does not work properly when I run it or debug quickly with Color Data analyzing

Question

The purpose of this code is to take a specific item from a Master Sheet so it can analyze it and use conditional formatting to assign it to a specific color sheet. I tried to make it simple by copying that row to its respective sheet and then just pasting it to the next available row using an xlUp and offset command. When I run this code in the debugger, it works perfectly fine when I go through each step slowly. However, when I try to run the code using full runtime or debug it quickly, it skips the step for it to get pasted to the next available line. Could anybody help me with this issue?

Sub Sort_Sheets()
Dim ColorRow As Long, NewRows As Range, MasRow As Range, ColorCol As String

Dim MastSheet As Worksheet, ColorVal As Variant, lastRow As Variant

Set Master = Worksheets("Master Sheet")

ColorRow = 2

ColorCol = "D"

ColorVal = Master.Cells(ColorRow, ColorCol).Value

Sheets(Array("Gray", "Pink", "Purple", "Yellow", "Orange", "Blue", "Rare", "Black", _
    "Red", "Green", "White")).Select
Sheets("Gray").Activate
Range("A2:I2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("J2").Select
Sheets("Gray").Select
Application.CutCopyMode = False
Master


While ColorVal <> ""

ColorVal = Master.Cells(ColorRow, ColorCol).Value

If InStr(1, ColorVal, "WHITE", vbTextCompare) <> 0 Then

    Master.Rows(ColorRow).Copy Destination:=Worksheets("White").Rows(ColorRow)
    
    If ColorRow > 2 Then
    
        Rows(ColorRow).Select
        Selection.Copy Destination:=Selection.End(xlUp).Offset(1, 0)
        Selection.Delete
        Application.CutCopyMode = False
        
        
        
    End If
   
  ElseIf InStr(1, ColorVal, "RED", vbTextCompare) <> 0 Then

    Master.Rows(ColorRow).Copy Destination:=Worksheets("Red").Rows(ColorRow)
    
    If ColorRow > 2 Then
    
        Rows(ColorRow).Select
        Selection.Copy
        Selection.End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
        Selection.Delete
        Application.CutCopyMode = False
        
        
        
        
    End If
   
   
    
    ElseIf InStr(1, ColorVal, "GREEN", vbBinaryCompare) <> 0 Then

    Master.Rows(ColorRow).Copy Destination:=Worksheets("GREEN").Rows(ColorRow)
    
    If ColorRow > 2 Then
    
        Rows(ColorRow).Select
        Selection.Copy Destination:=Selection.End(xlUp).Offset(1, 0)
        Selection.Delete
        Application.CutCopyMode = False
        
        
    End If
   
   
    
     ElseIf InStr(1, ColorVal, "BLACK", vbBinaryCompare) <> 0 Then

    Master.Rows(ColorRow).Copy Destination:=Worksheets("Black").Rows(ColorRow)
    
    If ColorRow > 2 Then
    
        Rows(ColorRow).Select
        Selection.Copy Destination:=Selection.End(xlUp).Offset(1, 0)
        Selection.Delete
        Application.CutCopyMode = False

        
    End If
    
ElseIf InStr(1, ColorVal, "GRAY", vbBinaryCompare) <> 0 Then

    Master.Rows(ColorRow).Copy Destination:=Worksheets("Gray").Rows(ColorRow)
    
    If ColorRow > 2 Then
    
        Rows(ColorRow).Select
        Selection.Copy Destination:=Selection.End(xlUp).Offset(1, 0)
        Selection.Delete
        Application.CutCopyMode = False

        
    End If
    
ElseIf InStr(1, ColorVal, "BLUE", vbBinaryCompare) <> 0 Then

    Master.Rows(ColorRow).Copy Destination:=Worksheets("Blue").Rows(ColorRow)
    
    If ColorRow > 2 Then
    
        Rows(ColorRow).Select
        Selection.Copy Destination:=Selection.End(xlUp).Offset(1, 0)
        Selection.Delete
        Application.CutCopyMode = False

        
    End If
    
ElseIf InStr(1, ColorVal, "ORANGE", vbBinaryCompare) <> 0 Then

    Master.Rows(ColorRow).Copy Destination:=Worksheets("Orange").Rows(ColorRow)
    
    If ColorRow > 2 Then
    
        Rows(ColorRow).Select
        Selection.Copy Destination:=Selection.End(xlUp).Offset(1, 0)
        Selection.Delete
        Application.CutCopyMode = False
        

        
    End If
    
ElseIf InStr(1, ColorVal, "YELLOW", vbBinaryCompare) <> 0 Then

    Master.Rows(ColorRow).Copy Destination:=Worksheets("Yellow").Rows(ColorRow)
    
    If ColorRow > 2 Then
    
        Rows(ColorRow).Select
        Selection.Copy Destination:=Selection.End(xlUp).Offset(1, 0)
        Selection.Delete
        Application.CutCopyMode = False

        
    End If
    
   
   End If
    


ColorRow = ColorRow + 1


    
    
Wend


End Sub

This [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) is probably your issue. Apply this to your code and if the issue is still there update the code in the question without using `.Select`. — Pᴇʜ, Jun 07 '21 at 15:41
I'd guess that your initial Select/ClearContents is not doing what you think it is, and not all sheets are being completely cleared. Only a range equivalent to whatever content is on "Grey" will be cleared from the other sheets using that approach. — Tim Williams, Jun 07 '21 at 16:57

Tim Williams · Answer 1 · 2021-06-08T20:29:40.910

EDIT - added "default" copy for unmatched values.

Try something like this:

Sub Sort_Sheets()
    
    Const ColorRow As Long = 2      'use constants for fixed values
    Const ColorCol As String = "D"
    
    Dim c As Range, arrSheets, s, rngDel As Range, wsDest As Worksheet
    Dim Master As Worksheet, ColorVal As Variant, wb As Workbook
    
    Set wb = ThisWorkbook 'or activeworkbook
    Set Master = wb.Worksheets("Master Sheet")
    
    arrSheets = Array("Gray", "Pink", "Purple", "Yellow", "Orange", _
                      "Blue", "Rare", "Black", "Red", "Green", "White")
    
    'clear each sheet individually
    For Each s In arrSheets
        With wb.Worksheets(s).UsedRange
            .Offset(1, 0).Resize(.Rows.Count - 1).ClearContents
        End With
    Next s
    
    Set c = Master.Cells(Rows.Count, ColorCol).End(xlUp) 'work from bottom to top
    Do While c.Row >= ColorRow
        ColorVal = c.Value
        If Len(ColorVal) > 0 Then
           Set wsDest = Nothing                   'unset destination sheet
           
           For Each s In arrSheets                'check for a color match
                If InStr(1, ColorVal, UCase(s), vbTextCompare) <> 0 Then
                    Set wsDest = wb.Worksheets(s)  'assign destination sheet
                    Exit For
                End If
           Next s
           
           'if no match was made then transfer row to "Rare"
           If wsDest Is Nothing Then Set wsDest = wb.Worksheets("Rare")
           c.EntireRow.Copy wsDest.Cells(Rows.Count, ColorCol) _
                                          .End(xlUp).EntireRow.Cells(1).Offset(1, 0)
           BuildRange rngDel, c 'collect for later deletion
        End If
        Set c = c.Offset(-1, 0) 'next row up
    Loop
    
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete 'delete any flagged rows

End Sub

'utility sub for building a single range from different ranges
Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
    If rngTot Is Nothing Then
        Set rngTot = rngAdd
    Else
        Set rngTot = Application.Union(rngTot, rngAdd)
    End If
End Sub

This seemed to have do the trick Tim! The only issue I have is that "Rare" is used for not so common colors so when I run the code it doesn't log anything into rare. Is there a internal function I can do that will allow me to determine if a value is in the array or not so I can put those colors in the "Rare" sheet? — MagnaSinne, Jun 08 '21 at 16:34
Are you saying that any row for which a color match is not made from the array should get copied to "Rare"? So all rows (with any value in ColD) should be copied and deleted? — Tim Williams, Jun 08 '21 at 16:53
I have used the concept from your code to copy and delete any rows that have the names of the sheets (excluding rare) on the "Rare" sheet, and now it leaves the remaining "rare" colors. My only issue is that now I am trying to use this code that I will post below to move the rows with values up to the next one despite the spaces. When I check the debugger, it tells me that the cell that is offset is empty even though it has a value in it. That is the last step before this code can be considered "complete." — MagnaSinne, Jun 08 '21 at 20:02
'Set r = Worksheets("Rare").Cells(Rows.Count, ColorCol).End(xlUp)' 'ColorVal = r.Offset(-1, 0).Value' — MagnaSinne, Jun 08 '21 at 20:28
It worked! All I had to do was delete the portion that deleted the sheets but it's perfect. Thank you! — MagnaSinne, Jun 08 '21 at 20:48

score 0 · Answer 2 · answered Jun 07 '21 at 15:52

By the sounds your code is relying on a calculation not done within the vba, so when it's updating the screen (e.g. re-calculating formulas or conditional formatting) between each line it's fine, but when it's not given the time to do that then it doesn't work.
If you use a breakpoint or debug.assert false to stop the code at different lines, you will be able to pin down exactly which line isn't working (this will take a few tries).

Best practice would state that you make the sheet stop relying on those external conditions as if they go wrong it makes everything very difficult to debug.
However, if you want a quick workaround, putting DoEvents on a spare line just above the first one where the problem shows should do the trick - it pauses the code long enough to let Excel recalculate whatever it needs to in the background.

Excel VBA code runs perfectly in Debug Mode if I debug slowly, but does not work properly when I run it or debug quickly with Color Data analyzing

2 Answers2