Code to work to specific row and not whole row

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,199
Office Version
  1. 2007
Platform
  1. Windows
Afternoon,

Working code in use shown below.

Currently this code operates the whole of column B where i would like it to stop at the last row.
So currently my last row with data in is row 19 BUT then i also see the message if i type in row 369 where at present its empty.
Basically find last row with data in and only have that row & up the page working with this code.

As time goes on my last row will be futher down the page.


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    
    On Error GoTo AllowEvents
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For Each c In Target
        If c.Row > 6 And c.Column < 11 And Not IsEmpty(c) Then
            If Not c.HasFormula Then
                c.Value = UCase(c.Value)
            Else
                c.Formula = Replace(c.Formula, "=", "=UPPER(") & ")"
            End If
        End If
    Next c
    
    If Target.CountLarge > 1000 Then GoTo AllowEvents
    
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        For Each c In Intersect(Target, Range("B:B"))
            If c.Row > 6 Then
                If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
                    MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
                    c.Value = ""
                    c.Select
                    GoTo AllowEvents
                Else
                    c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                End If
            End If
        Next c
               If Range("B7") = "" Then Range("E7") = ""
    End If
AllowEvents:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Range("B7").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
End Sub
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
What column should we use to determine where the current last row of data is?
 
Upvote 0
OK, so you can find the last used row in column B like this:
Code:
Dim lr as Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
Then, instead of using the entire column B like this:
Code:
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
you can change it to this:
Code:
    If Not Intersect(Target, Range("B1:B" & lr)) Is Nothing Then
 
Upvote 0
What did i do wrong as i still get the msg appear.


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
[COLOR=#ff0000]    Dim lr As Long
    lr = Cells(Rows.Count, "B").End(xlUp).Row[/COLOR]
    On Error GoTo AllowEvents
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For Each c In Target
        If c.Row > 6 And c.Column < 11 And Not IsEmpty(c) Then
            If Not c.HasFormula Then
                c.Value = UCase(c.Value)
            Else
                c.Formula = Replace(c.Formula, "=", "=UPPER(") & ")"
            End If
        End If
    Next c
    
    If Target.CountLarge > 1000 Then GoTo AllowEvents
    
    [COLOR=#ff0000]If Not Intersect(Target, Range("B1:B" & lr)) Is Nothing Then[/COLOR]
        For Each c In Intersect(Target, Range("B:B"))
            If c.Row > 6 Then
                If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
                    MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
                    c.Value = ""
                    c.Select
                    GoTo AllowEvents
                Else
                    c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                End If
            End If
        Next c
               If Range("B7") = "" Then Range("E7") = ""
    End If
AllowEvents:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Range("B7").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
End Sub
 
Upvote 0
You need to update row immediately following the other one too, in exactly the same way (hopefully, you are following along so it makes sense, so you are able to understand and employ these changes yourself going forward):
Code:
        For Each c In Intersect(Target, [COLOR=#ff0000]Range("B1:B" & lr)[/COLOR])
Don't be afraid to try to debug/play around/figure some of these things out too. That is a good way to learn how it all works.
 
Last edited:
Upvote 0
I understand what you have put or i think i do BUT i still see the msgbox.
Let me tell you what i do.

With the code shown below i open workbook & slect the worksheet MC LIST
I then select cell B19 as row 18 is the last row with values.
I then type anything so its less the 17 characters & then leave the cell.
I then see the msgbox


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim lr As Long
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    On Error GoTo AllowEvents
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For Each c In Target
        If c.Row > 6 And c.Column < 11 And Not IsEmpty(c) Then
            If Not c.HasFormula Then
                c.Value = UCase(c.Value)
            Else
                c.Formula = Replace(c.Formula, "=", "=UPPER(") & ")"
            End If
        End If
    Next c
    
    If Target.CountLarge > 1000 Then GoTo AllowEvents
    
    If Not Intersect(Target, Range("B7:B" & lr)) Is Nothing Then
        For Each c In Intersect(Target, Range("B7:B" & lr))
            If c.Row > 6 Then
                If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
                    MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
                    c.Value = ""
                    c.Select
                    GoTo AllowEvents
                Else
                    c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                End If
            End If
        Next c
               If Range("B7") = "" Then Range("E7") = ""
    End If
AllowEvents:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Range("B7").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
End Sub
 
Upvote 0
Ah, OK, I see now. I missed that the column you were using to check for the last row is the same column you are entering into. That is a bit tricky, because once you enter something in there, it now becomes the new last row!

Maybe we can check to see if it is the new last row, like this:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim lr As Long
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    On Error GoTo AllowEvents
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    For Each c In Target
        If c.Row > 6 And c.Column < 11 And Not IsEmpty(c) Then
            If Not c.HasFormula Then
                c.Value = UCase(c.Value)
            Else
                c.Formula = Replace(c.Formula, "=", "=UPPER(") & ")"
            End If
        End If
    Next c
    
    If Target.CountLarge > 1000 Then GoTo AllowEvents
    
    If Not Intersect(Target, Range("B7:B" & lr)) Is Nothing Then
        For Each c In Intersect(Target, Range("B7:B" & lr))
            If (c.Row > 6) [COLOR=#ff0000]And (c.Row < lr)[/COLOR] Then
                If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
                    MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
                    c.Value = ""
                    c.Select
                    GoTo AllowEvents
                Else
                    c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
                End If
            End If
        Next c
               If Range("B7") = "" Then Range("E7") = ""
    End If
AllowEvents:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Range("B7").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
End Sub
 
Last edited:
Upvote 0
That did the trick.

Many thanks for the new code
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,558
Messages
6,114,297
Members
448,564
Latest member
ED38

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