Oneindige loop

[HV_L]

Hoi,
Ik wil op een sheet zodra er ergens een waarde wordt aangepast (tekst in dit geval) dat de macro IF_Loop runt.
De macro zelf doet het goed (al zoek ik nog naar als er geen text staat (die verwijderd wordt bijv) de cel dan weer gewoon zonder opmaak wordt.

Zodra ik echter de Worksheet_Change erbij haal, schiet Excel in de stress en krijg ik een geen stack ruimte error en crasht de boel..
Wie helpt me het laatste stukje goed te krijgen?

Private Sub Worksheet_Change(ByVal Target As Range)    If Not Intersect(Target, Me.Range("TestRange")) Is Nothing Then
        Call IF_Loop
    End If
End Sub

Macro IF_Loop

Sub IF_Loop()    
    Dim cell As Range
    For Each cell In Range("Testrange")
        If (cell.Value = "a") Or (cell.Value = "A") Then
            cell.Value = "A"
            cell.Interior.Color = 15773696
            cell.Font.Color = vbWhite
            cell.Font.Size = 12
            cell.Font.Bold = True
        ElseIf (cell.Value = "Jo") Or (cell.Value = "jo") Then
            cell.Value = "Jo"
            cell.Interior.Color = 49407
            cell.Font.Size = 12
            cell.Font.Bold = True


        End If


    Next cell
End Sub

 

[offthelip]

My understanding of dutch is not great but I can see what your problem is, When you write a value in the Cells withthe Line

Cell.Value="A"

this triggers the worksheet change event again before it has finished the first one, so you get an ever increasing number of worksheet changeevents stacked up until excel crashes.
The solution is to turn the events of so modify your code as follows:

Sub IF_Loop()        
Dim cell As Range
    For Each cell In Range("Testrange")
        If (cell.Value = "a") Or (cell.Value = "A") Then
            Application.EnableEvents = False
            cell.Value = "A"
            cell.Interior.Color = 15773696
            cell.Font.Color = vbWhite
            cell.Font.Size = 12
            cell.Font.Bold = True
        ElseIf (cell.Value = "Jo") Or (cell.Value = "jo") Then
            Application.EnableEvents = False
            cell.Value = "Jo"
            cell.Interior.Color = 49407
            cell.Font.Size = 12
            cell.Font.Bold = True




        End If




    Next cell
    Application.EnableEvents =True 


End Sub

 

[James006]

Hallo,

Ik spreek geen Nederlands ... maar kan ...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("TestRange")) Is Nothing Then Exit Sub
Application.EnableEvents = False
        If UCase(CStr(Target)) = "A" Then
            With Me.Range("TestRange")
                .Value = "A"
                .Interior.Color = 15773696
                .Font.Color = vbWhite
                .Font.Size = 12
                .Font.Bold = True
             End With
        ElseIf UCase(CStr(Target)) = "JO" Then
            With Me.Range("TestRange")
                .Value = "Jo"
                .Interior.Color = 49407
                .Font.Size = 12
                .Font.Bold = True
            End With
         ElseIf Target = "" Then
            With Me.Range("TestRange")
                .ClearContents
                .Interior.Color = xlNone
                .Font.Color = vbBlack
            End With
        End If
Application.EnableEvents = True
End Sub

hoop dat dit zal helpen

 

[HV_L]

Thank you both! @offthelip: It seems to work, will test more and let know here. @James006, almost ok, it puts in the entire range the Value A, which is not what I ment..
I'm creating a kind of calendar where person A and Person Jo can type their in a cell whenever they are present.
I want the sheet to look uniform, so all cell with A should become the bleuish color, white fonts etc.
I also have the weekend days in a green color, wchich should not be "touched" by the code.
Hope this helps..
THanks again!

 

[James006]

Hello again,

Your English is just perfect ...!!!

Just remove the .Value instruction ...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("TestRange")) Is Nothing Then Exit Sub
Application.EnableEvents = False
        If UCase(CStr(Target)) = "A" Then
           Target = "A"
            With Me.Range("TestRange")
                .Interior.Color = 15773696
                .Font.Color = vbWhite
                .Font.Size = 12
                .Font.Bold = True
             End With
        ElseIf UCase(CStr(Target)) = "JO" Then
            Target = "Jo"
            With Me.Range("TestRange")
                .Interior.Color = 49407
                .Font.Color = vbBlack
                .Font.Size = 12
                .Font.Bold = True
            End With
         ElseIf Target = "" Then
            With Me.Range("TestRange")
                .Interior.Color = xlNone
                .Font.Color = vbBlack
            End With
        End If
Application.EnableEvents = True
End Sub

Hope this will help

 

[HV_L]

Hi James,
Now complete range gets same color...
The idea is that cells containing "A" become blue (15773696) (when "A" is typed in cell)
Cells with text "Jo" become color 49407.
Also, in this range there are green colored cells, which never should be changed How do I do this??
Finally, when a cell with Jo in it, is changed to no content, I want this cell to become blank again.

Hope this clearify my intentions with the sheet.
Appreciatie the help!
Cheers!

 

[James006]

Hello again,

Thanks for your explanations ...

Think my understanding is now better ...

One question ... in which cell do you input A ... is it anywhere in the Range ' TestRange ' ... ?

Below is a Test macro ... ONLY for the A case ... to make sure it is working properly ...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("TestRange")) Is Nothing Then Exit Sub
Dim lLoop As Long
Dim rFoundCell As Range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TEST : Dealing ONLY with the "A" Case ''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Application.EnableEvents = False
      If UCase(CStr(Target)) = "A" Then
         Target = "A"
          With Me.Range("TestRange")
            Set rFoundCell = .Cells(1, 1)
                For lLoop = 1 To WorksheetFunction.CountIf(.Cells, "A")
                Set rFoundCell = .Find(What:="A", After:=rFoundCell, _
                    LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, MatchCase:=False)
                    ' Adjust the specifics
                     With rFoundCell
                        .Interior.Color = 15773696
                        .Font.Color = vbWhite
                        .Font.Size = 12
                        .Font.Bold = True
                     End With
                Next lLoop
          End With
      End If
  Application.EnableEvents = True
End Sub

 

[HV_L]

Hi James,
The input is in the Range, but now nothing happens with this new code.
I type in the Range in a cell "A" press Enter nothing.. sorry..

 

[James006]

Hi,

You have to make sure your events are operational ...

In VBE ... Control G to open the Immediate Window ... and Type :

Application.EnableEvents = True

Then close the window ... you are back to Normal behaviour ...

HTH

 

[HV_L]

Did that, still nothing happens..
Is it maybe that in the actual sheet I'm typing a name instead of just one capital as I said earlier? Hope not.. if so, you can kick my butt..
This my actual code with text I'm typing in and searching to change the cell properties:

Private Sub Worksheet_Change(ByVal Target As Range)If Intersect(Target, Me.Range("TestRange")) Is Nothing Then Exit Sub
Dim lLoop As Long
Dim rFoundCell As Range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' TEST : Dealing ONLY with the "A" Case ''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Application.EnableEvents = False
      If UCase(CStr(Target)) = "Thea" Then
         Target = "Thea"
          With Me.Range("TestRange")
            Set rFoundCell = .Cells(1, 1)
                For lLoop = 1 To WorksheetFunction.CountIf(.Cells, "Thea")
                Set rFoundCell = .Find(What:="Thea", After:=rFoundCell, _
                    LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, MatchCase:=False)
                    ' Adjust the specifics
                     With rFoundCell
                        .Interior.Color = 15773696
                        .Font.Color = vbWhite
                        .Font.Size = 12
                        .Font.Bold = True
                     End With
                Next lLoop
          End With
      End If
  Application.EnableEvents = True
End Sub