Sub RandomTape()
    Dim sDirect As String, sOldDirect As String
    Dim bFlagColor As Boolean, bFlagDirect As Boolean
    Dim lColor As Long, lSymbol As Long, dSpeed As Double
    Dim lThreat As Long, lLife As Long
    Dim n As Long, i As Long, j As Long
    
    Randomize

    Range("B2:U21").Interior.Pattern = xlNone
    Range("B2:U21").ClearContents
    Cells(16, 23).Value = 1
    Cells(18, 23).ClearContents
    Cells(19, 23).Interior.Pattern = xlNone
    
    lColor = Cells(4, 23).Interior.Color
    bFlagColor = Cells(5, 23).Value
    If Cells(6, 23).Value Then dSpeed = 2 Else dSpeed = 1
    bFlagDirect = Cells(7, 23).Value
    lThreat = Cells(9, 23).Value
    lLife = Cells(11, 23).Value
    
    For n = 1 To lThreat
         i = Int(20 * Rnd + 2): j = Int(20 * Rnd + 2)
         Cells(i, j).Value = Chr$(136)
    Next n
    
    For n = 1 To lLife
         i = Int(20 * Rnd + 2): j = Int(20 * Rnd + 2)
         Cells(i, j).Value = Chr$(114)
    Next n
    
    i = Int(20 * Rnd + 2): j = Int(20 * Rnd + 2)
    n = 0: lLife = 0
           
    Do: Application.Wait (Now + TimeValue("0:00:01")) / dSpeed
        sDirect = ""
        If Cells(i - 1, j).Interior.Pattern = xlNone Then sDirect = sDirect & "U"
        If Cells(i, j + 1).Interior.Pattern = xlNone Then sDirect = sDirect & "R"
        If Cells(i + 1, j).Interior.Pattern = xlNone Then sDirect = sDirect & "D"
        If Cells(i, j - 1).Interior.Pattern = xlNone Then sDirect = sDirect & "L"
        
        If sDirect <> "" Then
            sDirect = Mid$(sDirect, Int(Len(sDirect) * Rnd + 1), 1)
            lSymbol = fSymbol(sOldDirect, sDirect)
            If bFlagDirect = True Then Cells(i, j).Value = Chr$(lSymbol)
            If n = 1 Then Cells(i, j).Value = Chr$(250)
            
            Select Case sDirect
            Case "U": i = i - 1
            Case "R": j = j + 1
            Case "D": i = i + 1
            Case "L": j = j - 1
            End Select
            
            If bFlagColor = True Then lColor = Int(16581375 * Rnd + 1)
            Cells(i, j).Interior.Color = lColor
            
            sOldDirect = sDirect
            n = n + 1
            
            If Cells(i, j).Value = Chr$(114) Then
                lLife = lLife + 1: Cells(16, 23).Value = lLife + 1
            End If
            
            If Cells(i, j).Value = Chr$(136) Then
                lLife = lLife - 1: Cells(16, 23).Value = lLife + 1
                If lLife < 0 Then Exit Do
            End If
        End If
    Loop Until sDirect = ""
    
    If sDirect = "" Then Cells(i, j).Value = Chr$(113)
    Cells(16, 23).Value = 0
    Cells(18, 23).Value = n
    Cells(19, 23).Interior.Color = lColor
    Beep
End Sub

Function fSymbol(sOldDirect As String, sDirect As String) As Long
    Select Case sOldDirect
    Case "U"
        Select Case sDirect
        Case "U": fSymbol = 53
        Case "R": fSymbol = 59
        Case "L": fSymbol = 58
        End Select
    Case "R"
        Select Case sDirect
        Case "U": fSymbol = 61
        Case "R": fSymbol = 52
        Case "D": fSymbol = 63
        End Select
    Case "D"
        Select Case sDirect
        Case "R": fSymbol = 57
        Case "D": fSymbol = 54
        Case "L": fSymbol = 56
        End Select
    Case "L"
        Select Case sDirect
        Case "U": fSymbol = 60
        Case "D": fSymbol = 62
        Case "L": fSymbol = 51
        End Select
    End Select
End Function

Sub test_()
    DoEvents
    Call RandomTape
    If Cells(18, 23).Value > 200 Then Beep: Exit Sub
'    Application.Wait Time:=Now + TimeValue("0:00:01")
    Call test_
End Sub