0

I am having this problem. I am experimenting with various code in Excel VBA. My problem is that, many of the times I do something illegal, and that's quite often as I try many things, I get a Runtime Error 1004.

My problem is, that after that, whatever I do fails to run and I simply cannot do anything including some code, unless I restart Excel. Is there any way to break out of this, without having to restart Excel every time? Reseting and breaking the code do not help either.

EDIT:After request I am posting the whole code. I have no errors in here at the moment, but if I encounter a new one I will post the code that caused it.

Sub tp() 'for test
    Image5.Shadow = True

End Sub

Private Sub Card1_Click()

End Sub

Sub Image1_Click()
    Call NewCard(1)
    'Range("L22").Value = 1
End Sub

Private Sub Image2_Click()

End Sub

Private Sub Image3_Click()

End Sub


Private Sub Image4_Click()

End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("I3,I7,I11,I15,P3,P7,P11,P15")) Is Nothing Then


        If Sheets("TheChamberOfSecrets").Range("H1").Value = 0 Then
            Sheets("TheChamberOfSecrets").Range("H1").Value = 1
            If IsNumeric(Target.Value) And (Not IsEmpty(Target)) Then
                If (Int(Target.Value) = Target.Value) Then
                    tmp = Target.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                    'Target.Value = Target.Value
                    'Target.Value = Int(Target.Value)
                    Sheets("TheChamberOfSecrets").Range(tmp).Value = Target.Value
                Else
                    tmp = Target.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                    Target.Value = Sheets("TheChamberOfSecrets").Range(tmp).Value
                End If
            ElseIf IsEmpty(Target) Then
                Target.Value = 0
                tmp = Target.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                Sheets("TheChamberOfSecrets").Range(tmp).Value = Target.Value
            Else
                tmp = Target.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                Target.Value = Sheets("TheChamberOfSecrets").Range(tmp).Value
            End If
            Sheets("TheChamberOfSecrets").Range("H1").Value = 0
        End If




    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Count = 1 Then
    If Not Intersect(Target, Range("L24:N24")) Is Nothing Then

        Call Locky
        Call Judge(Action(Target))

    ElseIf Not Intersect(Target, Range("K22")) Is Nothing Then

        Call up(1)

    ElseIf Not Intersect(Target, Range("N22")) Is Nothing Then

        Call up(2)

    ElseIf Not Intersect(Target, Range("K23")) Is Nothing Then

        Call down(1)

    ElseIf Not Intersect(Target, Range("N23")) Is Nothing Then

        Call down(2)

    ElseIf Not Intersect(Target, Range("J22")) Is Nothing Then

        Call shiftColour(1)

    ElseIf Not Intersect(Target, Range("O22")) Is Nothing Then

        Call shiftColour(2)

    ElseIf Not Intersect(Target, Range("I22")) Is Nothing Then

        Call RandomCard(1)

    ElseIf Not Intersect(Target, Range("P22")) Is Nothing Then

        Call RandomCard(2)

    ElseIf Not Intersect(Target, Range("I22")) Is Nothing Then

        'Range("G22").Value = "PENTE"
        RandomCard (1)

    ElseIf Not Intersect(Target, Range("P22")) Is Nothing Then
        RandomCard (2)

    ElseIf ((Not Intersect(Target, Range("I19")) Is Nothing) Or (Not Intersect(Target, Range("J19")) Is Nothing)) Then
        Call RandomHand

    ElseIf Not Intersect(Target, Range("H2,H6,H10,H14,Q2,Q6,Q10,Q14")) Is Nothing Then

        'Range("Player_2").Value = "lolwtfpwned"
        If Target.Value = "Active" Then

            Target.Interior.ColorIndex = 3
            Target.Value = "Inactive"
        Else
            Target.Interior.ColorIndex = 43
            Target.Value = "Active"
        End If
    ElseIf Not Intersect(Target, Range("I4,I8,I12,I16,P4,P8,P12,P16,O21")) Is Nothing Then

        Cells((Target.Row - 1), Target.Column).Value = RandomMoney()

    ElseIf Not Intersect(Target, Range("J2,J6,J10,J14,O2,O6,O10,O14")) Is Nothing Then

        Call ChangeDealer(Target)

    End If


End If
End Sub
Private Sub ChangeDealer(ByVal Target As Range)
    If Target.Address(RowAbsolute:=False, ColumnAbsolute:=False) <> Sheets("TheChamberOfSecrets").Range(DealerHolder).Value Then
        'Call ClearBlinds(Target)
        Call SetDealer(Target)
    End If

End Sub
Private Sub ClearBlinds(ByVal Target As Range)

End Sub

Private Sub SetDealer(ByVal Target As Range)
    DaAd = Target.Address(RowAbsolute:=False, ColumnAbsolute:=False)
    Sheets("TheChamberOfSecrets").Range(DealerHolder).Value = DaAd
    StartingPoint = Sheets("TheChamberOfSecrets").Range(DaAd).Value
    'Range("H1").Value = StartingPoint
    Target.Value = "       D"
    i = StartingPoint - 1
    If i < 1 Then
        i = i + 8
    End If
    DaAd = Sheets("TheChamberOfSecrets").Range(PlayerArray & i).Value
    Range(DaAd).Value = "      SB"
    i = i - 1
    If i < 1 Then
        i = i + 8
    End If
    DaAd = Sheets("TheChamberOfSecrets").Range(PlayerArray & i).Value
    Range(DaAd).Value = "      BB"


End Sub
Private Function RandomMoney() As Integer
    Call Randomize
    RandomMoney = (Int((15 - 3 + 1) * Rnd + 3)) * 100
End Function

Sub RandomHand()
    n1 = Int((52 - 1 + 1) * Rnd + 1)
    n2 = Int((51 - 1 + 1) * Rnd + 1)
    If n2 >= n1 Then
        n2 = n2 + 1
    End If

    Range(Card(1)).Value = n1
    Range(Card(2)).Value = n2

    Call UpdateCardImages


End Sub

Sub RandomCard(ByVal which As Integer)
    Call Randomize
    'randomValue = CInt(Math.Floor((upperbound - lowerbound + 1) * Rnd())) + lowerbound
    'Int ((upperbound - lowerbound + 1) * Rnd + lowerbound)
    'Value = CInt(Math.Floor((51 - 1 + 1) * Rnd())) + 1
    Value = Int((51 - 1 + 1) * Rnd + 1)
    If which = 1 Then
        other = 2
    Else
        other = 1
    End If
    If Value >= Range(Card(other)).Value Then
        Value = Value + 1
    End If

    Range(Card(which)).Value = Value

    Call UpdateCardImages

End Sub

Sub shiftColour(ByVal which As Integer)
    Dim tempo As Integer
    Dim base As Integer
    tempo = Range(Card(which)).Value - 1
    colour = tempo Mod 4
    base = (tempo \ 4) * 4
    colour = (colour + 1) Mod 4
    Range(Card(which)).Value = base + colour + 1

    Call UpdateCardImages

End Sub
Sub up(ByVal which As Integer)

    Range(Card(which)).Value = Range(Card(which)).Value + 4

    If Range(Card(which)).Value > 52 Then
        Range(Card(which)).Value = Range(Card(which)).Value - 52
    End If


    Call UpdateCardImages

End Sub
Sub down(ByVal which As Integer)

    Range(Card(which)).Value = Range(Card(which)).Value - 4

    If Range(Card(which)).Value < 1 Then
        Range(Card(which)).Value = Range(Card(which)).Value + 52
    End If

    Call UpdateCardImages

End Sub

Function Card(ByVal num As Integer) As String
    If num = 1 Then
        Card = "L22"
    ElseIf num = 2 Then
        Card = "M22"
    End If
End Function


Function Action(ByVal Target As Range) As Integer 'Define Action Chosen

    If Target = Range("L24") Then
            Range("N25").Value = 1
            Action = 1

    ElseIf Target = Range("M24") Then
            Range("N25").Value = 2
            Action = 2
    Else
            Range("N25").Value = 3
            Action = 3
    End If
End Function
Sub Locky() 'Lock Fields
    Range("L26").Value = 1
End Sub
Sub Unlocky() 'Unlock Fields
    Range("L26").Value = 0

End Sub

Sub Judge(ByVal Action As Integer) 'Analyse Situation and define verdict
    If Range("L25").Value = "Right" Then
        Range("L25").Value = "Wrong"
    Else
        Range("L25").Value = "Right"
    End If
End Sub

Sub ChangeHand(ByVal Sel As Integer)
    Sheets("Sheet1").Range(PriorityCell).Value = Sel
    Call UpdateCardImages
    Call SwitchPriority

End Sub
Private Sub NewCard(ByVal Sel As Integer)
    If ((Range("L22").Value <> Sel) And (Range("M22").Value <> Sel)) Then
        ChangeHand (Sel)
        'Range("L22").Value = 1
    Else
        Call SwitchCards
    End If
End Sub
Private Sub SwitchPriority()
    If PriorityCell = "L22" Then
        Sheets("Sheet1").Range(PriorityHolder).Value = "M22"
        Range("M23").Value = "        ^"
        Range("L23").Value = ""
    Else
        Sheets("Sheet1").Range(PriorityHolder).Value = "L22"
        Range("L23").Value = "        ^"
        Range("M23").Value = ""
    End If
End Sub

Private Function PriorityCell() As String

    PriorityCell = Sheets("Sheet1").Range(PriorityHolder).Value

End Function
Private Sub UpdateCardImages()
    Call LoadImage(1)
    Call LoadImage(2)

End Sub
Private Sub LoadImage(ByVal which As Integer)

End Sub


Private Function PriorityHolder() As String
    PriorityHolder = "L27"
End Function
Private Sub SwitchCards()
    Call SwitchPriority
    Dim Temp As Integer
    Temp = Range("L22").Value
    Range("L22").Value = Range("M22").Value
    Range("M22").Value = Temp
    Call UpdateCardImages


End Sub

Private Function DealerHolder() As String

    DealerHolder = "I1"
End Function
Private Function PlayerArray() As String
    PlayerArray = "K"
End Function

Sub DONOTHINGFFS()
End Sub
2
  • Your question includes no sample code or Excel/OS version, so it's almost impossible to suggest what the problem might be, other than there is "something wrong" with your Excel installation, because the behavior you're describing is not something I've seen before in any version of Excel. Apr 19, 2014 at 21:56
  • @TimWilliams Added the code. NOTE: I have no errors at the moment, if I encounter any new ones, i will post the code responsible.
    – Noob Doob
    Apr 19, 2014 at 22:29

1 Answer 1

1

In VBA checkout the section on On Error . This will allow you to include logic in your code to trap errors and allow you to analyze them.

If you post some examples of your problem logic, we can assist you in using On Error

3
  • Yes, I have knowledge of this feature. However, I do not need to use that thing in my logic. The error occurs while I simply try what is the right thing to put into my code. And if Error 1004 hits, no change of code can unblock the frozen state of my code. Even if I comment out all the new block I added. I have to restart excel in order to write new code and see if it works, with a high probability of getting stuck again. So it's not a matter of wrong logic, it's how I escape this frustrating situation when I have simply written the wrong thing and I want to change it.
    – Noob Doob
    Apr 19, 2014 at 22:17
  • Post your code. Some error are so bad they cause Excel to die. Apr 19, 2014 at 22:19
  • I have no errors at the moment. I finally get the code to work properly, it's just that when I don't, Excel freezes needing a restart. I imagine that I should paste the new code I wrote, if I encounter another situation. I don't know if posting the whole code would be helpful, it approaches 350 lines. But I will for any case.
    – Noob Doob
    Apr 19, 2014 at 22:23

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.