do until loop with if statement that applies on different columns (vba)

[ddesantis]

Hi,
I'm scratching my head around what I think "a very simple piece" of code...but I'm a VBA beginner
I have to perform 2 tasks, and while I've completed the first one, the other is giving me a lot of troubles...

1st step: clear the content of a range of cells when I switch the xls validation list (yes,no). This works

Private Sub WorkSheet_Change(ByVal Target As Range)

If Target.Address = "$E$170" Then Range("$E$178:$E$187").ClearContents

If Target.Address = "$E$174" Then Range("$E$178:$E$187").ClearContents

2nd step:
- I have 2 ranges of value $D$178:$D$187 and $E$178:$E$187
- the range $D$178:$D$187 can assume the following values: Yes, No, Please select
- If any value in the range $D$178:$D$187 assume value "Yes" the corresponding value in the range $E$178:$E$187 has to assume value "Yes"
- If any value in the range $D$178:$D$187 assume value "No" the corresponding value in the range $E$178:$E$187 has to assume value "No"
- If any value in the range $D$178:$D$187 assume value "Please select" the corresponding value in the range $E$178:$E$187 will result in a validation list "Yes" or "No"

It's worth saying that the range $E$178:$E$187 has already a xls data validation list set (Yes,No)

Example
D180="Yes" then E180="Yes"

D183="No" then E183="No"

D185="Please select" then E185= validation list "Yes" or "No"

I tried as follows but xls crashed

CODE HERE

Set Rng = Range("$E$178:$E$187")
        Range("$D$178").Select
        Do Until Selection.Value = "$D$188"
                  If Selection.Value = "Yes" Then
                          Rng = "Yes"
                  Else
                          Rng = "No"
                  End If
            Loop

End Sub

my assumption is that in all other cases in the range $S$178:$E$187 (i.e. "Please select") the code doesn't apply and I can select "Yes" or "No" in the xls data validation list $E$178:$E$187

I managed to get the code above start working but I always got the following error
run time error '2147417848 (80010108)':
Method 'Value' of object 'Range' failed

CODE HERE
even with

Select Case Range("$D$178").Text
Case "Yes"
Range("$E$178").Value = "Yes"
End Select
End Sub

Hope it's clear, I would appreciate any help you can provide!

[SamT]

That Loop Does not increment. IOW the Selection is "D178" every time. XL crashes because the loop never exits.

As best as I can tell, this does what I think you are trying to accomplish.

Option Explicit

Private Sub WorkSheet_Change(ByVal Target As Range)
     
  'Stop Screen flicker and speed ue Execution
  Application.ScreenUpdating = False
  'Prevent this Sub from triggering Change Event
  Application.EnableEvents = False
    
  'Clear Range E and restore to values in Range D
  If (Target.Address = "E170") Or (Target.Address = "E174") Then
    Range("E178:E187").ClearContents
    Range("E178:E187").Value = Range("D178:D187").Value
    
  'If range D changes, Change corresponding cell in Range E. 
  ElseIf Not Intersect(Target, Range("D178:D187")) Is Nothing Then 'Double negative = positive
    Target.Offset(0, 1).Value = Target.Value
  End If
    
  'Restore Application to default state
  Application.ScreenUpdating = True
  Application.EnableEvents = True
    
End Sub

[ddesantis]

Hi SamT,
Thanks for your reply.

But apparently is not working.

My step 1 is no longer working (the content in "E178:E187" doesn't clear up), neither step 2 (the content in "E178:E187" does not automatically get populated).

In particular step 2 should work as follows
- If any value in $D$178:$D$187 is "Yes" then the corrisponding value in $E$178:$E$187 is "Yes"
- If any value in $D$178:$D$187 is "No" then the corrisponding value in $E$178:$E$187 is "No"
- If any value in $D$178:$D$187 is "Please select" the user can choose "Yes" or "No2 in the corrisponding value in $E$178:$E$187

Please let me know if it's still unclear

Thanks!

[SamT]

First Run Sub "RestoreDefaults" Then try changing the value in E170-174

Only then Use this code. All I did was to add an ElseIf statement for the "Please Select" case, and a msgbox to see if the Application had somehow lost it's default state.

Let me know what happens after you run RestoreDefaults and after you use the new code.

Sub RestoreDefaults()
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

Option Explicit
 
Private Sub WorkSheet_Change(ByVal Target As Range)
     
     'Stop Screen flicker and speed ue Execution
    Application.ScreenUpdating = False
     'Prevent this Sub from triggering Change Event
    Application.EnableEvents = False
     
     'Clear Range E and restore to values in Range D
    If (Target.Address = "E170") Or (Target.Address = "E174") Then
        Range("E178:E187").ClearContents
        Range("E178:E187").Value = Range("D178:D187").Value
        'Temporary line for troubleshooting
        MsgBox "Worksheet Change Event Triggered"
         
         'If range D changes, Change corresponding cell in Range E.
    ElseIf Not Intersect(Target, Range("D178:D187")) Is Nothing Then 'Double negative = positive
        If LCase(Target.Value) = "yes" Or LCase(Target.Value) = "no" Then
          Target.Offset(0, 1).Value = Target.Value
        ElseIf LCase(Target.Value) = "please select" Then
          Target.Offset(0, 1).Value = ""
        End If
    End If
     
     'Restore Application to default state
    Application.ScreenUpdating = True
    Application.EnableEvents = True
     
End Sub

[ddesantis]

Hi SamT,
now the second part works perfectly! but the following piece seems not to work
If (Target.Address = "E170") Or (Target.Address = "E174") Then
Range("E178:E187").ClearContents

In particular when I change the value in E170 the range E178:E187 retain its values

It's also strange that the code only works if I put all the cells in this format $E$178

[ddesantis]

but with these two lines the clear contents works, but if I try to replace them in your code, the code breaks
If Target.Address = "$E$170" Then Range("$E$178:$E$187").ClearContents
If Target.Address = "$E$174" Then Range("$E$178:$E$187").ClearContents

[SamT]

I'm sorry, my bad

Because Target.Address returns absolute address strings ("$E$170"), you will have to edit this line in my Post #4 code to include the "$"s

If (Target.Address = "$E$170") Or (Target.Address = "$E$174") Then

I tested the code on my machine with the Absolute Address indicators and it worked fine.

I normally use

If Target Is Range("E170") Then

which works because Range("$E$170") is Range("E170")

[ddesantis]

many thanks samT it works perfectly!!!

[SamT]