Moving Rows Up (Scroll) To Defined Row Number for Viewing

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,570
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have code that allows a user to enter a value into cell A6. The code then checks that value to those values currently in column A (excluding A6) to see if that value already exists. If it does, a prompt allows the user to view the row of data of the original value. How can I go about scrolling that roll up to row 6? (Row 6 is the default data entry row, and if a duplicate is found, it is deleted).

Here is my code in which I tried using activewindow scrollcolumn and scrollrow functions. I don't think they are working though as I had expected. Probably because I don't know how to use them.

Code:
Sub Worksheet_Change(ByVal Target As Range)
    Dim cval As String, aval As String
    Dim bval As String
    Dim msg1 As String, msg2 As String, msg3 As String
    Dim acnt As Long
    Dim lrow As Long
    Dim ui1 As Variant
    
    If Not Application.Intersect(Columns(1), Range(Target.Address)) Is Nothing Then
Stop
        If IsEmpty(Target) Then
            Exit Sub
        Else
            'aval = "R" & Target.Value
            aval = Target.Value
            lrow = ws_pdata.Cells(ws_pdata.Rows.Count, "A").End(xlUp).Row
            acnt = Application.WorksheetFunction.CountIf(ws_pdata.Columns(1), CLng(aval))
            If acnt > 1 Then
                acnt = Application.WorksheetFunction.Match(CLng(aval), ws_pdata.Range("A7:A" & lrow), 0) + 6
                ui1 = MsgBox("Permit already exists in database at row " & acnt & "." & Chr(13) & "View exisiting entry?", vbYesNo, "Permit Entry Error")
                If ui1 = vbYes Then
                    ws_pdata.Unprotect
                    Application.EnableEvents = False
                    ws_pdata.Rows(6).EntireRow.Delete
                    Application.EnableEvents = True
                    MsgBox "Scrolling to row " & acnt
                    ActiveWindow.ScrollColumn = 1
                    ActiveWindow.ScrollRow = acnt - (acnt - 6)
                    ws_pdata.Protect
                    Exit Sub
                Else
                    Exit Sub
                End If
            End If
        End If
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
A few suggestions if I may:
1. Select cell A7, then View/Freeze Panes
2. Don't delete row 6 every time - just clear the contents instead (unless there's a reason to delete the entire row?)
3. Try the following code on a copy of your workbook

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Target <> "" And Target.Address = "$A$6" Then
        Application.EnableEvents = False
        Dim val As String, i As Long, mbyes
        val = Target.Value
        If WorksheetFunction.CountIf(Columns(1), val) > 1 Then
            i = WorksheetFunction.Match(val, Range("A7", Cells(Rows.Count, "A").End(xlUp)), 0) + 6
            mbyes = MsgBox("Permit already exists in database at row " & i & Chr(13) & "View exisiting entry?", vbYesNo, "Permit Entry Error")
            If mbyes = vbYes Then
                With Me
                    .Unprotect
                    .Rows(6).EntireRow.ClearContents
                    Application.Goto Range("A" & i), scroll:=True
                    .Protect
                End With
            End If
        End If
        Application.EnableEvents = True
    End If
End Sub
 
Upvote 0
Hello Kevin,
Thank you for the effort in providing a solution.
I integrated your code into mine and and tested it. In run time, it doesn't work. The intended row is not scrolled to row 6. However, in debugging by stepping through the code, the scrolling does work, but as soon as you set out of
Code:
Application.Goto Range("A" & i), scroll:=True
, the database reverts back to the original with an empty row six displayed.
Note that the panes are frozen between line 5 and 6.
Also, it is preferred that line 6 be deleted to avoid problems in other code which require an unbroken database.
 
Upvote 0
Kevin, any solution by chance as to why this isn't working?
 
Upvote 0
Unfortunately I don't think I can help any further. You said you "integrated" my code into yours:
I integrated your code into mine
but I have no idea how you did this or what the final code looks like. You also mentioned some other code:
to avoid problems in other code
but I have no idea what this other code is or how it affects the overall program flow. I also don't understand your overall methodology of needing to delete row 6 each time - in the context of the user entering new data into cell A6 each time. If you delete row 6 then what was row 7 becomes row 6 - so I have no idea what your data looks like before the code is run.
Sorry, but hopefully someone else on the forum will be able to assist you.
Best wishes
 
Upvote 0
No worries Kevin, the very fact that you chose to help is most appreciated.

As an FYI for anyone following, I haven't been deleting row 6 while testing Kevin's code. I've been testing it as he had provided. As far as integration goes, I simply replaced my old code with Kevin's.
The code suggested does scroll the desired row to view up to row 6 as it's supposed to, but it doesn't stay in that position to view. If I run the code in run time, there appears to be no effect, but I think that's only because it happens so fast. I know your code is scrolling because when I step through the code, I can see it happening.

Perhaps I can accomplish what I need to do with either presenting a user with a user form displaying the data in that row, or perhaps create a "target" row in the upper frozen range of rows that I can use as a temporary pasting location of the row data instead of scrolling to row 6.
 
Upvote 0

Forum statistics

Threads
1,223,879
Messages
6,175,142
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top