Reputation: 1083
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
Reputation: 9976
Try this...
Application.Goto Range("A8").End(xlDown).Offset(1, 0) , True
Upvotes: 2
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