Issue with Ranges and Worksheet_Change

mloucel

New Member
Joined
Feb 22, 2016
Messages
37
I have this code:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim myRange As Range

' Set range to check this are the cells that have the Notes
' Note1 Note2 Note3
Set myRange = Range("AG2:AG1500, AI2:AI1500, AK2:AK1500")


' Only run code if cell is in selected range
If Intersect(Target, myRange) Is Nothing Then
Exit Sub
Else
' If column Note has data and column Date is blank, insert current date in column Date
If Len(Target) > 0 And Len(Target.Offset(0, -1)) = 0 Then
Target.Offset(0, -1) = Date
Else
' If column Note is blank and column Date has data, remove data from column Date
If Len(Target) = 0 And Len(Target.Offset(0, -1)) > 0 Then
Target.Offset(0, -1).ClearContents
End If
End If
End If

Set otherRange = Range("G2:G1500, H2:H1500, N2:N1500, R2:R1500, T2:U1500, AB2:AB1500, AG2:AG1500, AI2:AI1500, AK2:AK1500")
If Intersect(Target, otherRange) Is Nothing Then Exit Sub
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True


End Sub

The routine has to check this range of cells ( G2:G1500, H2:H1500, N2:N1500, R2:R1500, T2:U1500, AB2:AB1500, AG2:AG1500, AI2:AI1500, AK2:AK1500 ) and convert all of them to Uppercase.
But as you can see ONLY AB2:AB1500, AG2:AG1500, AI2:AI1500, AK2:AK1500 actually work, the rest ( G2:G1500, H2:H1500, N2:N1500, R2:R1500, T2:U1500 ) is simply ignored and I am out of IDEAS
Can someome be so kind to explain to me what the heck am I doing wrong..

I am fairly NEWBIE in VBA so my apologies any help will be greatly appreciated..
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Code:
'Look at what happens here:
Set myRange = Range("AG2:AG1500, AI2:AI1500, AK2:AK1500")
If Intersect(Target, myRange) Is Nothing Then
[B][COLOR=#ff0000]    Exit Sub[/COLOR]
[/B]

'Instead, perhaps something like this:
Set myRange = Range("AG2:AG1500, AI2:AI1500, AK2:AK1500")
If Not Intersect(Target, myRange) Is Nothing Then
    'do stuff with myRange
End If
'Go on to look at OtherRange
 
Upvote 0
PS: Your code also doesn't allow for the possibility of the user changing more than one cell at the same time, e.g. copy/pasting a block of cells.

If target does contain more than one cell, then testing Len(Target) and Target.Value will cause errors. Two ways around this:

1. Test each cell individually:

Code:
Dim rngCell As Range

For Each rngCell In Intersect(Target, Range("AG2:AG1500, AI2:AI1500, AK2:AK1500"))
    If rngCell.Value = "Something" Then ...
    If Len(rngCell) Then ....
Next rngCell

2. Run your code only if one cell has been selected

Code:
If Target.Cells.Count = 1 Then
    'do stuff
 
Upvote 0
Thanks Stephen..
I modified my code like this and it works but I'm a newbie and I know is not perfect is it possible to make it better and how?

Code:
' I have to probe my first range 1st if not it doesn't work

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Dim myRange As Range
    Dim otherRange As Range


Set otherRange = Range("G2:G1500, H2:H1500, N2:N1500, R2:R1500, T2:U1500, AB2:AB1500")


If Not Intersect(Target, otherRange) Is Nothing Then
    Application.EnableEvents = False
    Target.Value = UCase(Target.Value)
    Application.EnableEvents = True
    Exit Sub
End If


    
'   Set range to check this are the cells that have the Notes
'                           Note1       Note2       Note3
    Set myRange = Range("AG2:AG1500, AI2:AI1500, AK2:AK1500")
'   Only run code if cell is in selected range
    If Not Intersect(Target, myRange) Is Nothing Then
'       If column Note has data and column Date is blank, insert current date in column Date
        If Len(Target) > 0 And Len(Target.Offset(0, -1)) = 0 Then
            Target.Offset(0, -1) = Date
'   make the letters UPPERCASE
        
            Application.EnableEvents = False
            Target.Value = UCase(Target.Value)
            Application.EnableEvents = True
      Exit Sub
        Else
'           If column Note is blank and column Date has data, remove data from column Date
            If Len(Target) = 0 And Len(Target.Offset(0, -1)) > 0 Then
                Target.Offset(0, -1).ClearContents
            End If
          Exit Sub
        End If
    End If
End Sub
 
Upvote 0
I modified my code like this and it works but I'm a newbie and I know is not perfect ...

It's pretty good!

I have modified your code to allow for Target containing more than one cell. Now if the user copies and pastes a whole row, for example, the code will loop through each cell and make the required changes.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)    

    Dim myRange As Range, otherRange As Range, rngCell As Range

    Application.EnableEvents = False
    Set otherRange = Intersect(Target, Range("G2:G1500, H2:H1500, N2:N1500, R2:R1500, T2:U1500, AB2:AB1500"))
    Set myRange = Intersect(Target, Range("AG2:AG1500, AI2:AI1500, AK2:AK1500"))
    
    If Not otherRange Is Nothing Then
        For Each rngCell In otherRange
            rngCell.Value = UCase(rngCell.Value)
        Next rngCell
    End If
    
    If Not myRange Is Nothing Then
        For Each rngCell In myRange
            If Len(rngCell) Then
                rngCell.Value = UCase(rngCell.Value)
                If Len(rngCell.Offset(, -1)) Then rngCell.Offset(, -1).Value = Date
            Else
                rngCell.Offset(, -1).ClearContents
            End If
        Next rngCell
    End If
    
    Application.EnableEvents = True
    
End Sub

I have also removed the On Error Resume Next at the start of your code. Occasionally it will be appropriate to use On Error Resume Next in a controlled way, to prevent/catch errors. Here's a simple example:

Code:
Dim lMatchNo As Long, lValueToMatch

lValueToMatch = 5   'say

On Error Resume Next    'Otherwise next line may error
lMatchNo = Application.Match(lValueToMatch, Range("A1:A10"), 0)
On Error GoTo 0

If lMatchNo = 0 Then
    'No match found
Else
    'do stuff with lMatchNo
End If

But putting On Error Resume Next at the start of a module is not good coding practice. Any subsequent errors are simply ignored, so your code will behave/not behave in unexpected ways and you won't know why.
 
Upvote 0
Stephen

Thank you so much, for your praise and the correction of my error also I had to (not sure if the correct word is "correct" or "amend" the code to:

If Len(rngCell.Offset(, -1)) = 0 Then rngCell.Offset(, -1).Value = Date
instead of
If Len(rngCell.Offset(, -1)) Then rngCell.Offset(, -1).Value = Date

when I debugged the condition: "If Len(rngCell.Offset(, -1))" appears to validate FALSE and the THEN is never executed

I have no idea why but it works when I validate "=0", so I let it go, but if you have time I would much appreciate your input.

I'm learning bit by bit...
 
Upvote 0
I have no idea why but it works when I validate "=0", so I let it go, but if you have time I would much appreciate your input.

Sorry, that was my mistake! I misread your code and got the IF condition around the wrong way.

My intention was to use the slightly more succinct:

If Len(Target) Then ....

instead of:

If Len(Target) > 0 Then ....

The two are equivalent because any non-zero Len (e.g. 1,2,3,4 ...) will coerce to the Boolean TRUE.
 
Upvote 0
Sorry, that was my mistake! I misread your code and got the IF condition around the wrong way.

My intention was to use the slightly more succinct:

If Len(Target) Then ....

instead of:

If Len(Target) > 0 Then ....

The two are equivalent because any non-zero Len (e.g. 1,2,3,4 ...) will coerce to the Boolean TRUE.

Sorry Stephen Too NEWBIE .. I got lost, but is working maybe 1 day when I get more experience I will understand what you mean..
In the meantime I am forever thankful.
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,927
Members
448,533
Latest member
thietbibeboiwasaco

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
Back
Top