Oneindige loop

HV_L

New Member
Joined
Dec 4, 2009
Messages
43
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?
Code:
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
Code:
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
 

Some videos you may like

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,666
Office Version
  1. 2010
Platform
  1. Windows
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
Code:
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:
Code:
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

Well-known Member
Joined
Apr 4, 2009
Messages
3,680
Hallo,

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

Code:
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

New Member
Joined
Dec 4, 2009
Messages
43
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

Well-known Member
Joined
Apr 4, 2009
Messages
3,680

ADVERTISEMENT

Hello again,

Your English is just perfect ...!!!

Just remove the .Value instruction ...

Code:
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

New Member
Joined
Dec 4, 2009
Messages
43
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

Well-known Member
Joined
Apr 4, 2009
Messages
3,680

ADVERTISEMENT

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 ...

Code:
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

New Member
Joined
Dec 4, 2009
Messages
43
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

Well-known Member
Joined
Apr 4, 2009
Messages
3,680
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

New Member
Joined
Dec 4, 2009
Messages
43
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:

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,310
Messages
5,600,884
Members
414,413
Latest member
Sinbin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top