Code to work to specific row and not whole row

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
2,609
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
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,135
Office Version
365
Platform
Windows
What column should we use to determine where the current last row of data is?
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,135
Office Version
365
Platform
Windows
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
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
2,609
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
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,135
Office Version
365
Platform
Windows
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:

MARK858

Well-known Member
Joined
Nov 12, 2010
Messages
11,312
Office Version
365, 2010
Platform
Windows, Mobile
Too slow
 
Last edited:

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
2,609
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
 

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
51,135
Office Version
365
Platform
Windows
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:

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
2,609
That did the trick.

Many thanks for the new code
 
Last edited:

Forum statistics

Threads
1,077,784
Messages
5,336,327
Members
399,076
Latest member
vullistax

Some videos you may like

This Week's Hot Topics

Top