user7415328
user7415328

Reputation: 1083

VBA: Take user to last used row?

I am using the following code to try and take the user to the first available empty row. This is designed to act as a kind of go to the first empty row link.

Code:

  'Go Bottom
    If Target.Address = "$K$3" Then
    Range("A8").End(xlDown).Offset(1, 0).Select
    End If

The code selects the last used row but does not scroll the cell into view. The user still has to scroll down.

Please can someone show me where i am going wrong?

Full Code:

Option Explicit
Option Compare Text
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Message
ActiveSheet.DisplayPageBreaks = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False

  'Go Bottom
    If Target.Address = "$K$3" Then
    Range("A8").End(xlDown).Offset(1, 0).Select
    End If


    'Clear Search Box
    If Target.Address = "$L$3:$M$3" Then

    On Error Resume Next
    Target.Cells.Interior.Pattern = xlNone
    Target.Cells.Value = ""
    SendKeys "{F2}"

    Else
    If Target.Address <> "$L$3:$M$3" Then
    Range("L3").Value = "Search Supplier Name, Number"
    End If
    End If





Message:
Application.DisplayAlerts = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Exit Sub

End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Message
On Error Resume Next

ActiveSheet.DisplayPageBreaks = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

'Insert Depot Memo Data for user
 Dim oCell As Range, targetCell As Range
    Dim ws2 As Worksheet
    On Error GoTo Message
    If Not Intersect(Target, Range("B:B")) Is Nothing Then ' <-- run this code only if a value in column B has changed
        If Not GetWb("Depot Memo", ws2) Then Exit Sub

        With ws2
            For Each targetCell In Target
                Set oCell = .Range("J1", .Cells(.Rows.Count, "J").End(xlUp)).Find(What:=targetCell.Value, LookIn:=xlValues, LookAt:=xlWhole)
                If Not oCell Is Nothing Then
                    Application.EnableEvents = False



                    'Set Format of cell
                    targetCell.ClearFormats
                    targetCell.Font.Name = "Arial"
                    targetCell.Font.Size = "10"
                    targetCell.Font.Color = RGB(128, 128, 128)
                    targetCell.HorizontalAlignment = xlCenter
                    targetCell.VerticalAlignment = xlCenter
                   targetCell.Borders(xlEdgeBottom).LineStyle = xlContinuous
                    targetCell.Borders(xlEdgeTop).LineStyle = xlContinuous
                   targetCell.Borders.Color = RGB(166, 166, 166)
                   targetCell.Borders.Weight = xlThin



                    targetCell.Offset(0, -1).Value = Now()
                    targetCell.Offset(0, 1).Value = oCell.Offset(0, 1)
                     targetCell.Offset(0, 2).Value = oCell.Offset(0, -2)
                     targetCell.Offset(0, 3).Value = oCell.Offset(0, -7)

                    Application.EnableEvents = True
                End If
            Next
        End With
    End If




Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True



 'Prompt missed on sale
    If Not Intersect(Target, Range("N:N")) Is Nothing And ActiveCell.Value = "Issue Complete" Then
    If Target.Cells.Count < 8 Then
    Dim MSG1 As Variant

    MSG1 = MsgBox("Did Item Miss On-Sale?", vbYesNo, "Feedback")
    If MSG1 = vbYes Then
    Range("O" & ActiveCell.Row).Value = "Yes"
    Else
    Range("O" & ActiveCell.Row).Value = "No"
    End If

    Range("P" & ActiveCell.Row).Value = DateDiff("d", CDate(Format(Range("A" & ActiveCell.Row).Value, "dd/mm/yyyy;@")), Date)


    End If
    End If



 If Not Intersect(Target, Range("D" & ActiveCell.Row)) Is Nothing And Target.Value <> "" Then
 Call PhoneBook2
 End If






'Send Email - Receipt of Issue

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
If Not Intersect(Target, Range("F:F")) Is Nothing Then
If Target.Cells.Count < 8 Then
If Target.Cells.Offset(0, 8).Value = "" Then

Call SendEmail0


End If
End If
End If



'Send Email - Status Change

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
If Not Intersect(Target, Range("N:N")) Is Nothing Then
If Target.Cells.Count < 8 Then
If Target.Cells.Offset(0, 8).Value = "" Then

Call SendEmail


End If
End If
End If


Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True











Message:
Application.DisplayAlerts = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

End Sub

Thanks

Upvotes: 0

Views: 87

Answers (2)

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

Try this...

Application.Goto Range("A8").End(xlDown).Offset(1, 0) , True

Upvotes: 2

Ionut
Ionut

Reputation: 91

Did you try like this:

If Target.Address = "$K$3" Then
Range("A8").End(xlDown).Offset(1, 0).Activate
End If

you can also find the last row and then go one more row like this

Dim lastRowSheetSix As Long
lastRowSheetSix = ThisWorkbook.Worksheets("PrepareEmailTL-RRD").Range("C1").SpecialCells(xlCellTypeLastCell).Row
lastRowSheetSix=lastRowSheetSix+1

lastRowSheetSix.Select or (Activate) as you wish

Upvotes: 0

Related Questions