thomas.szwed
04-10-2008, 08:09 AM
[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
04-10-2008, 09:44 AM
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
04-10-2008, 09:58 AM
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
Bob Phillips
04-11-2008, 03:15 AM
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.