'CurrentRow' Expression & Skipping through records

[thomas.szwed]

[Hi there,

I currently have a user form that can skip through records on my user form with two buttons < and >. (See attached picture). There is a textbox in between these buttons indicating the row number of record we are looking at. The code for these buttons is below. Is there anyway i could build somthing that allows the user to enter a number into this textbox, press return and then its skips to the relevant record???


Private Sub btnNext_Click()
' Increment row number:
lCurrentRow = lCurrentRow + 1
' Show contents of new row in the form:
txtSurname.Text = Cells(lCurrentRow, 1).Value
txtForename.Text = Cells(lCurrentRow, 2).Value
ddlAssignee.Text = Cells(lCurrentRow, 3).Value
txtPersNum.Text = Cells(lCurrentRow, 4).Value
txtStartDate.Text = Cells(lCurrentRow, 5).Value
txtEndDate.Text = Cells(lCurrentRow, 6).Value
ddlDivision.Text = Cells(lCurrentRow, 7).Value
ddlLocation.Text = Cells(lCurrentRow, 8).Value
txtLineManager.Text = Cells(lCurrentRow, 9).Value
txtVCS.Text = Cells(lCurrentRow, 10).Value
ddlHealth.Text = Cells(lCurrentRow, 11).Value
txtRow.Text = lCurrentRow


End Sub
Private Sub btnPrev_Click()
' Show previous only if not already in first row:
If lCurrentRow > 1 Then
' Decrement row number:
lCurrentRow = lCurrentRow - 1
' Show contents of new row in the form:
txtSurname.Text = Cells(lCurrentRow, 1).Value
txtForename.Text = Cells(lCurrentRow, 2).Value
ddlAssignee.Text = Cells(lCurrentRow, 3).Value
txtPersNum.Text = Cells(lCurrentRow, 4).Value
txtStartDate.Text = Cells(lCurrentRow, 5).Value
txtEndDate.Text = Cells(lCurrentRow, 6).Value
ddlDivision.Text = Cells(lCurrentRow, 7).Value
ddlLocation.Text = Cells(lCurrentRow, 8).Value
txtLineManager.Text = Cells(lCurrentRow, 9).Value
txtVCS.Text = Cells(lCurrentRow, 10).Value
ddlHealth.Text = Cells(lCurrentRow, 11).Value
txtRow.Text = lCurrentRow

End If
End Sub


Many Thanks for any help

[mdmackillop]

Untested but try this. BTW, I would put all that text in a separate sub and call it from the button macros as well.


Sub Textbox1_AfterUpdate() '<== Rename as required
lCurrentRow = textbox1.Value
' Show contents of new row in the form:
Call Updates(CurrentRow)
End Sub

Sub Updates(CurrentRow As Long)
txtSurname.Text = Cells(lCurrentRow, 1).Value
txtForename.Text = Cells(lCurrentRow, 2).Value
ddlAssignee.Text = Cells(lCurrentRow, 3).Value
txtPersNum.Text = Cells(lCurrentRow, 4).Value
txtStartDate.Text = Cells(lCurrentRow, 5).Value
txtEndDate.Text = Cells(lCurrentRow, 6).Value
ddlDivision.Text = Cells(lCurrentRow, 7).Value
ddlLocation.Text = Cells(lCurrentRow, 8).Value
txtLineManager.Text = Cells(lCurrentRow, 9).Value
txtVCS.Text = Cells(lCurrentRow, 10).Value
ddlHealth.Text = Cells(lCurrentRow, 11).Value
txtRow.Text = lCurrentRow
End Sub

[Bob Phillips]

I'd tidy it up a bit

(also untested)



Option Explicit

Private lCurrentRow As Long

Private Sub btnNext_Click()
' Increment row number:
lCurrentRow = lCurrentRow + 1
' Show contents of new row in

'some code to check noit greater than max

txtRow.Text = lCurrentRow
End Sub
Private Sub btnPrev_Click()
' Show previous only if not already in first row:
If lCurrentRow > 1 Then
' Decrement row number:
lCurrentRow = lCurrentRow - 1
End If

txtRow.Text = lCurrentRow
End Sub

Private Sub txtRow_Change()
lCurrentRow = Val(txtRow.Text)
Call UpdateDetails
End Sub

Private Sub UserForm_Activate()
lCurrentRow = 1
txtRow.Text = lCurrentRow
End Sub

Private Sub UpdateDetails()
txtSurname.Text = Cells(lCurrentRow, 1).Value
txtForename.Text = Cells(lCurrentRow, 2).Value
ddlAssignee.Text = Cells(lCurrentRow, 3).Value
txtPersNum.Text = Cells(lCurrentRow, 4).Value
txtStartDate.Text = Cells(lCurrentRow, 5).Value
txtEndDate.Text = Cells(lCurrentRow, 6).Value
ddlDivision.Text = Cells(lCurrentRow, 7).Value
ddlLocation.Text = Cells(lCurrentRow, 8).Value
txtLineManager.Text = Cells(lCurrentRow, 9).Value
txtVCS.Text = Cells(lCurrentRow, 10).Value
ddlHealth.Text = Cells(lCurrentRow, 11).Value
End Sub

[thomas.szwed]

Thanks for your code both people. I have implemeted yours XLD. I just have two queries.

Firstly, when on the userform, if you highlight the row number and press delete ready to enter the row number you want to find it comes up with a runtime error.....>See attachment....I think this may be something to do that when you delete the current value in the row number box it tries to find a blank value of which of course there is none.....? Is this right and is there a way around?

Secondly is there anyway i could block it reading row 1 as this is the row with my column headings in.......

Many Thanks

[Bob Phillips]

Can you post the workbook rather than a picture?

[thomas.szwed]

Sure, here you go.....

[Bob Phillips]

And the password is ...

[Bob Phillips]

I opened it read only, so this should get you starteds



Option Explicit

'---------------------------------------------------------------------------------------
' Module : IAC Form
' DateTime : 31/11/2007 10:55
' Author : Tom Szwed
' Purpose : Data entry form for Excel, with Search facility
'---------------------------------------------------------------------------------------

Private lCurrentRow As Long

Dim MyArray(6, 11)
Public MyData As Range, c As Range

Private Sub UserForm_Activate()

lCurrentRow = 2

txtSurname.Text = Cells(lCurrentRow, 1).Value
txtForename.Text = Cells(lCurrentRow, 2).Value
ddlAssignee.Text = Cells(lCurrentRow, 3).Value
txtPersNum.Text = Cells(lCurrentRow, 4).Value
txtStartDate.Text = Cells(lCurrentRow, 5).Value
txtEndDate.Text = Cells(lCurrentRow, 6).Value
ddlDivision.Text = Cells(lCurrentRow, 7).Value
ddlLocation.Text = Cells(lCurrentRow, 8).Value
txtLineManager.Text = Cells(lCurrentRow, 9).Value
txtVCS.Text = Cells(lCurrentRow, 10).Value
ddlHealth.Text = Cells(lCurrentRow, 11).Value
txtRow.Text = lCurrentRow

End Sub

Private Sub btnAddRecord_Click()
'next empty cell in column A

Set c = Range("a65536").End(xlUp).Offset(1, 0)
Application.ScreenUpdating = False 'speed up, hide task

If Not IsError(Application.Match(Val(Me.txtPersNum.Text), Sheets("Master Data").Columns(4), 0)) Then
MsgBox "That Personnel Number is already assigned - try another", vbCritical, "Duplicate found"
Else
'update it
'write userform entries to database
c.Value = Me.txtSurname.Value
c.Offset(0, 1).Value = Me.txtForename.Value
c.Offset(0, 2).Value = Me.ddlAssignee.Value
c.Offset(0, 3).Value = Me.txtPersNum.Value
c.Offset(0, 4).Value = Me.txtStartDate.Value
c.Offset(0, 5).Value = Me.txtEndDate.Value
c.Offset(0, 6).Value = Me.ddlDivision.Value
c.Offset(0, 7).Value = Me.ddlLocation.Value
c.Offset(0, 8).Value = Me.txtLineManager.Value
c.Offset(0, 9).Value = Me.txtVCS.Value
c.Offset(0, 10).Value = Me.ddlHealth.Value
c.Offset(0, 11).Value = "C"

Call ClearForm

End If

Application.ScreenUpdating = True
End Sub

Private Sub btnDelete_Click()
Dim msgResponse As String 'confirm delete
Application.ScreenUpdating = False
'get user confirmation
msgResponse = MsgBox("This will delete the selected record. Continue?", _
vbCritical + vbYesNo, "Delete Entry")
Select Case msgResponse 'action dependent on response
Case vbYes
'c has been selected by Find button
Set c = ActiveCell
c.EntireRow.Delete 'remove entry by deleting row
'restore form settings

Call SetupButtons(False, False, True, True)
Call ClearForm

Case vbNo

Exit Sub 'cancelled

End Select
Application.ScreenUpdating = True

End Sub

Private Sub btnSearch_Click()
Dim strFind, FirstAddress As String 'what to find
Dim rSearch As Range 'range to search
Set rSearch = Sheet1.Range("a1", Range("a65536").End(xlUp))
strFind = Me.txtSurname.Value 'what to look for
Dim f As Integer
With rSearch
Set c = .Find(strFind, LookIn:=xlValues)
If Not c Is Nothing Then 'found it
c.Select
With Me 'load entry to form
.txtForename.Value = c.Offset(0, 1).Value
.ddlAssignee.Value = c.Offset(0, 2).Value
.txtPersNum.Value = c.Offset(0, 3).Value
.txtStartDate.Value = c.Offset(0, 4).Value
.txtEndDate.Value = c.Offset(0, 5).Value
.ddlDivision.Value = c.Offset(0, 6).Value
.ddlLocation.Value = c.Offset(0, 7).Value
.txtLineManager.Value = c.Offset(0, 8).Value
.txtVCS.Value = c.Offset(0, 9).Value
.ddlHealth.Value = c.Offset(0, 10).Value
.btnEdit.Enabled = False 'allow amendment or
.btnDelete.Enabled = False 'allow record deletion
.btnAddRecord.Enabled = False 'don't want to duplicate record
f = 0
End With

FirstAddress = c.Address

Do
f = f + 1 'count number of matching records
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress

If f > 1 Then
MsgBox "There are " & f & " instances of " & strFind
Me.Height = 406
End If

Else: MsgBox strFind & " - No records found" 'search failed

End If

End With

End Sub

Private Sub btnEdit_Click()

Application.ScreenUpdating = False
Set c = ActiveCell ' c selected by Search
c.Value = Me.txtSurname.Value ' write amendments to database
c.Offset(0, 1).Value = Me.txtForename.Value
c.Offset(0, 2).Value = Me.ddlAssignee.Value
c.Offset(0, 3).Value = Me.txtPersNum.Value
c.Offset(0, 4).Value = Me.txtStartDate.Value
c.Offset(0, 5).Value = Me.txtEndDate.Value
c.Offset(0, 6).Value = Me.ddlDivision.Value
c.Offset(0, 7).Value = Me.ddlLocation.Value
c.Offset(0, 8).Value = Me.txtLineManager.Value
c.Offset(0, 9).Value = Me.txtVCS.Value
c.Offset(0, 10).Value = Me.ddlHealth.Value

'restore Form
With Me
.btnEdit.Enabled = False
.btnDelete.Enabled = False
.btnAddRecord.Enabled = True
.txtSurname.Value = vbNullString
.txtForename.Value = vbNullString
.ddlAssignee.Value = vbNullString
.txtPersNum.Value = vbNullString
.txtStartDate.Value = vbNullString
.txtEndDate.Value = vbNullString
.ddlDivision.Value = vbNullString
.ddlLocation.Value = vbNullString
.txtLineManager.Value = vbNullString
.txtVCS.Value = vbNullString
.ddlHealth.Value = vbNullString
End With
Application.ScreenUpdating = True

End Sub

Private Sub btnFindAll_Click()
Dim FirstAddress As String
Dim strFind As String 'what to find

Dim rSearch As Range 'range to search
Dim fndA, fndB, fndC, fndD, fndE, fndF, fndG, fndH, fndI, fndJ, fndK As String
Dim head1, head2, head3, head4, head5, head6, head7, head8, head9, head10, head11 As String 'heading s for list
Dim i As Integer
i = 1
Set rSearch = Sheet1.Range("a2", Range("a65536").End(xlUp))
strFind = Me.txtSurname.Value

With rSearch
Set c = .Find(strFind, LookIn:=xlValues)
If Not c Is Nothing Then 'found it
c.Select
'load the headings
head1 = Range("a1").Value
head2 = Range("b1").Value
head3 = Range("c1").Value
head4 = Range("d1").Value
head5 = Range("e1").Value
head6 = Range("f1").Value
head7 = Range("g1").Value
head8 = Range("h1").Value
head9 = Range("i1").Value
head10 = Range("j1").Value
head11 = Range("k1").Value
With Me.lbxSearchResults
MyArray(0, 0) = head1
MyArray(0, 1) = head2
MyArray(0, 2) = head3
MyArray(0, 3) = head4
MyArray(0, 4) = head5
MyArray(0, 5) = head6
MyArray(0, 6) = head7
MyArray(0, 7) = head8
MyArray(0, 8) = head9
MyArray(0, 9) = head10
MyArray(0, 10) = head11
End With
FirstAddress = c.Address
Do
'Load details into Listbox
fndA = c.Value
fndB = c.Offset(0, 1).Value
fndC = c.Offset(0, 2).Value
fndD = c.Offset(0, 3).Value
fndE = c.Offset(0, 4).Value
fndF = c.Offset(0, 5).Value
fndG = c.Offset(0, 6).Value
fndH = c.Offset(0, 7).Value
fndI = c.Offset(0, 8).Value
fndJ = c.Offset(0, 9).Value
fndK = c.Offset(0, 10).Value

MyArray(i, 0) = fndA
MyArray(i, 1) = fndB
MyArray(i, 2) = fndC
MyArray(i, 3) = fndD
MyArray(i, 4) = fndE
MyArray(i, 5) = fndF
MyArray(i, 6) = fndG
MyArray(i, 7) = fndH
MyArray(i, 8) = fndI
MyArray(i, 9) = fndJ
MyArray(i, 10) = fndK

i = i + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> FirstAddress

End If
End With
'Load data into LISTBOX
Me.lbxSearchResults.List() = MyArray

End Sub

Private Sub txtPersNum_Change()
If txtPersNum = vbNullString Then Exit Sub
If Not IsNumeric(txtPersNum) Then
MsgBox "Numbers only"
txtPersNum = vbNullString
End If
End Sub

Private Sub btnSelect_Click()
Dim r As Integer
If Me.lbxSearchResults.ListIndex = -1 Then 'not selected
MsgBox " No selection made"
ElseIf Me.lbxSearchResults.ListIndex >= 0 Then 'User has selected
r = Me.lbxSearchResults.ListIndex

With Me
.txtForename.Value = lbxSearchResults.List(r, 1)
.txtSurname.Value = lbxSearchResults.List(r, 0)
.ddlAssignee.Value = lbxSearchResults.List(r, 2)
.txtPersNum.Value = lbxSearchResults.List(r, 3)
.txtStartDate.Value = lbxSearchResults.List(r, 4)
.txtEndDate.Value = lbxSearchResults.List(r, 5)
.ddlDivision.Value = lbxSearchResults.List(r, 6)
.ddlLocation.Value = lbxSearchResults.List(r, 7)
.txtLineManager.Value = lbxSearchResults.List(r, 8)
.txtVCS.Value = lbxSearchResults.List(r, 9)
.ddlHealth.Value = lbxSearchResults.List(r, 10)

Call SetupButtons(True, True, False, True)

Me.Height = 290

End With

End If
End Sub

Private Sub btnSelectRecord_Click()

With Range("D2:D65000")

Set c = .Cells.Find(what:=Me.txtPersNum.Value, _
after:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
Lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
End With

c.Offset(0, -3).Activate

Call SetupButtons(True, True, False, True)

End Sub

Private Sub txtPersNum_AfterUpdate()

If Not IsError(Application.Match(Val(Me.txtPersNum.Text), Sheets("Master Data").Columns(4), 0)) Then

MsgBox "That Personnel Number is already assigned - try another", vbCritical, "Duplicate found"

With Me

.txtPersNum.Value = vbNullString
.btnExport.Enabled = False
End With
End If

End Sub

Private Sub btnExport_Click()
Call CopyToExport
End Sub

Private Sub btnRestart_Click()

Unload Me
AddNewStarter.Show
End Sub

Private Sub btnNext_Click()
' Increment row number:
lCurrentRow = lCurrentRow + 1
' Show contents of new row in

'some code to check not greater than max
txtRow.Text = lCurrentRow

End Sub
Private Sub btnPrev_Click()
' Show previous only if not already in first row:
If lCurrentRow > 2 Then

' Decrement row number:
lCurrentRow = lCurrentRow - 1
End If
txtRow.Text = lCurrentRow

End Sub

Private Sub txtRow_Change()
If txtRow.Text = "" Then txtRow.Text = "2"
lCurrentRow = Val(txtRow.Text)
Call UpdateDetails
End Sub

Private Sub UpdateDetails()
txtSurname.Text = Cells(lCurrentRow, 1).Value
txtForename.Text = Cells(lCurrentRow, 2).Value
ddlAssignee.Text = Cells(lCurrentRow, 3).Value
txtPersNum.Text = Cells(lCurrentRow, 4).Value
txtStartDate.Text = Cells(lCurrentRow, 5).Value
txtEndDate.Text = Cells(lCurrentRow, 6).Value
ddlDivision.Text = Cells(lCurrentRow, 7).Value
ddlLocation.Text = Cells(lCurrentRow, 8).Value
txtLineManager.Text = Cells(lCurrentRow, 9).Value
txtVCS.Text = Cells(lCurrentRow, 10).Value
ddlHealth.Text = Cells(lCurrentRow, 11).Value

Call SetupButtons(False, False, True, False)
End Sub

Private Sub SetupButtons(SetEdit As Boolean, SetDelete As Boolean, _
SetAdd As Boolean, SetExport As Boolean)
With Me

.btnEdit.Enabled = SetEdit
.btnDelete.Enabled = SetDelete
.btnAddRecord.Enabled = SetAdd
.btnExport.Enabled = SetExport
End With
End Sub

Private Sub ClearForm()
'clear the form
With Me

.txtSurname.Value = vbNullString
.txtForename.Value = vbNullString
.ddlAssignee.Value = vbNullString
.txtPersNum.Value = vbNullString
.txtStartDate.Value = vbNullString
.txtEndDate.Value = vbNullString
.ddlDivision.Value = vbNullString
.ddlLocation.Value = vbNullString
.txtLineManager.Value = vbNullString
.txtVCS.Value = vbNullString
.ddlHealth.Value = vbNullString
End With
End Sub

[thomas.szwed]

Sorry, its "pastille". Will have a look at how this runs now? did you manage to fix the bug?

[Bob Phillips]

Yes.

[thomas.szwed]

You legend....will code back in when im in work on Monday.

Thanks a mil

[thomas.szwed]

XLD this works fine apart from one little issue. I have a validation on one of the text boxes on the form that only allows a number entry. When you type in 1 into the row number text box it immediatley skips to row one which is of course the header row. I then get an error message because it is only allowed to accept numbers into the one of my text boxes and it is instead picking up the header row which is full of titles in text.

Would there be anyway to stop this happening> by perhaps having to press return after entering a number?

For instance if you went to type in 155 it would give you the error message as soon as you typed in the number 1.......you can see for yourself in the workbook i attached earlier.

Many Thanks

[thomas.szwed]

Any ideas on this?

Appreciate your help...