Select change code offsetting from variable

[Oberon70]

Hi, I have the below code, I am trying to accomplish to more things.

1. I need to offset LastCell to the cell above.
2. I don't want a date entered if the cell is note blank.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False

Dim rng As Range
Dim Lastcell As String

Lastcell = FindLast(3)


Set rng = Range("A2:" & (Lastcell.Offset(1, 0)))


If Not Intersect(Target, rng) Is Nothing Then
ActiveSheet.Cells.Interior.ColorIndex = xlColorIndexNone
  Target.Interior.ColorIndex = 24
End If


If Not Intersect(Target, rng) Is Nothing Then
If Target.Column = 5 Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column) = Date
Application.EnableEvents = True
End If
End If

If Not Intersect(Target, rng) Is Nothing Then
If Target.Column = 7 Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column) = Date
Application.EnableEvents = True

End If
End If

End Sub

Function FindLast(lRowColCell As Long, _
                    Optional sSheet As String, _
                    Optional sRange As String)
'Find the last row, column, or cell using the Range.Find method
'lRowColCell: 1=Row, 2=Col, 3=Cell

Dim lrow As Long
Dim lCol As Long
Dim wsFind As Worksheet
Dim rFind As Range

    'Default to ActiveSheet if none specified
    On Error GoTo ErrExit
    
    If sSheet = "" Then
        Set wsFind = ActiveSheet
    Else
        Set wsFind = Worksheets(sSheet)
    End If

    'Default to all cells if range no specified
    If sRange = "" Then
        Set rFind = wsFind.Cells
    Else
        Set rFind = wsFind.Range(sRange)
    End If
    
    On Error GoTo 0

    Select Case lRowColCell
    
        Case 1 'Find last row
            On Error Resume Next
            FindLast = rFind.Find(What:="*", _
                            After:=rFind.Cells(1), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
            On Error GoTo 0

        Case 2 'Find last column
            On Error Resume Next
            FindLast = rFind.Find(What:="*", _
                            After:=rFind.Cells(1), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
            On Error GoTo 0

        Case 3 'Find last cell by finding last row & col
            On Error Resume Next
            lrow = rFind.Find(What:="*", _
                           After:=rFind.Cells(1), _
                           LookAt:=xlPart, _
                           LookIn:=xlFormulas, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlPrevious, _
                           MatchCase:=False).Row
            On Error GoTo 0

            On Error Resume Next
            lCol = rFind.Find(What:="*", _
                            After:=rFind.Cells(1), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
            On Error GoTo 0

            On Error Resume Next
            FindLast = wsFind.Cells(lrow, lCol).Address(False, False)
            'If lRow or lCol = 0 then entire sheet is blank, return "A1"
            If Err.Number > 0 Then
                FindLast = rFind.Cells(1).Address(False, False)
                Err.Clear
            End If
            On Error GoTo 0

    End Select
    
    Exit Function
    
ErrExit:

    MsgBox "Error setting the worksheet or range."

End Function

 

[Oberon70]

Okay, I have most of the issues resolve except offsetting the cell address found by the function Findlast

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Application.ScreenUpdating = False

Dim rng As Range
Dim Lastcell As String

'Lastcell = FindLast(3)


Set rng = Range("A2:" & FindLast(3))

Debug.Print rng.Address


    If Not Intersect(Target, rng) Is Nothing Then
    ActiveSheet.Cells.Interior.ColorIndex = xlColorIndexNone
    Target.Interior.ColorIndex = 24
End If


If Not Intersect(Target, rng) Is Nothing Then
    If Target.Column = 7 Then
        If Intersect(Target, rng) = "" Then
            If Not Intersect(Target, rng) Is Nothing Then
                Application.EnableEvents = False
                Cells(Target.Row, Target.Column) = Date
                Application.EnableEvents = True
            End If
        End If
    End If
End If
End Sub

 

[Oberon70]

I also have found one error. When I highlight more than one cell in the Date Column I get the error message Run-time error 13: Type mismatch.

and then Debug says the error is

If Not Intersect(Target, rng) Is Nothing Then
    If Target.Column = 5 Then
        If Intersect(Target, rng) = "" Then
            If Not Intersect(Target, rng) Is Nothing Then
                Application.EnableEvents = False
                Cells(Target.Row, Target.Column) = Date
                Application.EnableEvents = True
            End If
        End If
    End If
End If

 

[Alex Blakenburg]

I am not sure if you mean the cell that is up one row from the Lastcell.
If you do and you want to use the Function FindLast that you have, then it is something like this:

    Dim rngLastcell As Range    
    Set rngLastcell = ActiveSheet.Range(FindLast(3)).Offset(-1)

 

[Oberon70]

Thank you, I was missing the .offset(-1) as, but have change the line

Set rng = Range("A2:" & FindLast(3)).Offset(-1)

and it worked.

 

[Alex Blakenburg]

Thank you, I was missing the .offset(-1) as, but have change the line

Set rng = Range("A2:" & FindLast(3)).Offset(-1)

and it worked.

Are you sure that gives you what you are after ?
If you are trying to set rng to the cells that have data the FindLast should you give the last row & column used and you shouldn't need to offset.

Also putting offset after the whole Range(From:To) means both ends are offset by -1 so the A2 also becomes A1.

What are you trying to achieve with your offset ?
If you add this line after your set command you can see what it is doing in the immediate window.
Debug.Print rng.address

 

[dmt32]

Hi,

Just for interest, I created an update to Ron de Bruins FindLast function that removes need for all the repeating Find codes also and to make function more intuitive, enumeration to provide IntelliSense for the user to select from has been included.

If you want to use updated version, make a back-up & then delete the existing function.

Place BOTH these codes in a STANDARD module

Enum XLFindLast
    xlFindLastRow = 1
    xlFindLastColumn
    xlFindLastCell
End Enum

Function FindLast(ByVal FindWhat As XLFindLast, Optional ByVal TargetRange As Range) As Variant
    Dim sh               As Worksheet
    Dim RowCol(1 To 2)   As Long, i As Long

    '------------------------------------------------------------------------------------------------------------
    '                                       FindLast Function
    '                                 (update to Ron de Bruin Function)
    '------------------------------------------------------------------------------------------------------------
    'Author     | dmt32
    '------------------------------------------------------------------------------------------------------------
    'Version    | V1 June 2021
    '------------------------------------------------------------------------------------------------------------
    'Purpose    | returns from range with data, last row or last column number or, last used cell address.
    '------------------------------------------------------------------------------------------------------------
    'Parameters |  Name            | Required/Optional | Data type     |   Description
    '           |------------------------------------------------------------------------------------------------
    '           |  FindWhat         |   Required        |   Integer     |   An integer value ( 1 - 3 )
    '           |  TargetRange      |   Optional        |   Range       |   worksheet range
    '------------------------------------------------------------------------------------------------------------
    'Returns    |  Variant
    '------------------------------------------------------------------------------------------------------------
    
    If TargetRange Is Nothing Then Set TargetRange = ActiveSheet.Cells
    Set sh = TargetRange.Parent
    
    FindWhat = IIf(FindWhat > xlFindLastCell, xlFindLastCell, IIf(FindWhat < xlFindLastRow, xlFindLastRow, FindWhat))
    
    On Error Resume Next
    For i = xlRows To xlColumns
        With TargetRange.Find(what:="*", After:=TargetRange.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _
                            SearchOrder:=i, SearchDirection:=xlPrevious, MatchCase:=False)
            RowCol(i) = Choose(i, .Row, .Column)
            
        End With
        If RowCol(i) = 0 Then RowCol(i) = 1
    Next i
     On Error GoTo 0
     
    FindLast = IIf(FindWhat = xlFindLastRow, RowCol(xlRows), _
               IIf(FindWhat = xlFindLastColumn, RowCol(xlColumns), _
              sh.Cells(RowCol(xlRows), RowCol(xlColumns)).Address(0, 0)))
End Function

I changed the optional parameters from separate string input values to single Range object as this will also pass the Parent (worksheet)

Your existing code should continue to work with the function using just the Integer values

Lastcell = FindLast(3)

But when used you will be prompted with the IntelliSense to make choices a little easier and code more readable.

Hope Helpful

Dave

 

[Oberon70]

Cool, and thank you. I will try it out.

 

[dmt32]

Cool, and thank you. I will try it out.

welcome hope you and others find it useful

Dave