Code to work to specific row and not whole row

[ipbr21054]

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.

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]

What column should we use to determine where the current last row of data is?

 

[ipbr21054]

Hi,

Its B

 

[Joe4]

OK, so you can find the last used row in column B like this:

Dim lr as Long
lr = Cells(Rows.Count, "B").End(xlUp).Row

Then, instead of using the entire column B like this:

    If Not Intersect(Target, Range("B:B")) Is Nothing Then

you can change it to this:

    If Not Intersect(Target, Range("B1:B" & lr)) Is Nothing Then

 

[ipbr21054]

What did i do wrong as i still get the msg appear.

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]

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

        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.

 

[MARK858]

Too slow

 

[ipbr21054]

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

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]

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:

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

 

[ipbr21054]

That did the trick.

Many thanks for the new code