Database form with two methods to select data

Z

Zebulon

New Member
Joined
May 23, 2014
Messages
32
I have a simple vba form for showing the customer database with First, Previous, Next and Last Buttons in the bottom of the form for de-/incrementing the database row number to display each customer’s data (20 columns).
But I want to be able to also choose the actual customer in the form via its alphabetic customer code in the first upper (and only) Combobox. I can populate the ComboBox but I can’t change the customer in the Combobox without messing up the rest of the textboxes, i.e. I want the selection in the Combobox to display the correct data in the other textboxes, including the row number, and vice versa. Is it possible to have 2 methods in the same form for changing/displaying data?
 
Sort by date Sort by votes
Hi,
It would be helpful if you post the code here behind your form or better still, place copy of your workbook in a dropbox - someone here may then be able to offer some suggestions.

Dave
 
Last edited:
Upvote 0
Hi Dave,
here's the code:
Code: 
Dim LastRow As Integer, r As Long
Public Sub UserForm_Initialize()
    LastRow = FindLastRow
    CustomerID.RowSource = "CDB" 'populating the ComboBox with the first column in the database
    GetData
End Sub
Private Sub GetData()
If IsNumeric(RowNumber.Text) Then
    r = CLng(RowNumber.Text)
Else
    ClearData
    MsgBox "Illegal row number"
    Exit Sub
End If

If r > 1 And r <= LastRow Then
    CustomerID.Text = Cells(r, 1) 'ComboBox
    CustomerName.Text = Cells(r, 2) ' Only TextBoxes below
    Address1.Text = Cells(r, 3)
    Address2.Text = Cells(r, 4)
    Prefix.Text = Cells(r, 5)
    Zip.Text = Cells(r, 6)
    City.Text = Cells(r, 7)
    Country.Text = Cells(r, 8)
    Delivery1.Text = Cells(r, 9)
    Delivery2.Text = Cells(r, 10)
    DeliveryZip.Text = Cells(r, 11)
    DeliveryTown.Text = Cells(r, 12)
    Delivery_Terms_Point.Text = Cells(r, 13)
    Base_Currency.Text = Cells(r, 14)
    Region.Text = Cells(r, 15)
    Contact.Text = Cells(r, 16)
    Telephone.Text = Cells(r, 17)
    Account.Text = Cells(r, 18)
    VAT_Reg_no.Text = Cells(r, 19)

    DisableSave
ElseIf r = 1 Then
    ClearData
Else
    ClearData
    MsgBox "Invalid row number"
End If
End Sub
Private Sub ClearData()
CustomerID.Text = "" 'ComboBox
CustomerName.Text = ""
Address1.Text = ""
Address2.Text = ""
Prefix.Text = ""
Zip.Text = ""
Country.Text = ""
City.Text = ""
Country.Text = ""
Delivery1.Text = ""
Delivery2.Text = ""
DeliveryZip.Text = ""
DeliveryTown.Text = ""
Delivery_Terms_Point.Text = ""
Base_Currency.Text = ""
Region.Text = ""
Contact.Text = ""
Telephone.Text = ""
Account.Text = ""
VAT_Reg_no.Text = ""
End Sub
Private Function FindLastRow()
r = 2
Do While r < 65536 And Len(Cells(r, 1).Text) > 0
    r = r + 1
Loop
FindLastRow = r
End Function
Private Sub CommandButton3_Click() 'First
    RowNumber.Text = "2"
End Sub
Private Sub CommandButton4_Click() 'Previous
If IsNumeric(RowNumber.Text) Then
    r = CLng(RowNumber.Text)
    r = r - 1
    If r > 1 And r <= LastRow Then
        RowNumber.Text = FormatNumber(r, 0)
    End If
End If
End Sub
Private Sub CommandButton5_Click() 'Next
If IsNumeric(RowNumber.Text) Then
    r = CLng(RowNumber.Text)
    r = r + 1
    If r > 1 And r <= LastRow Then
        RowNumber.Text = FormatNumber(r, 0)
    End If
End If
End Sub
Private Sub CommandButton6_Click() 'Last
    LastRow = FindLastRow - 1
    RowNumber.Text = FormatNumber(LastRow, 0)
End Sub
Private Sub RowNumber_Change() 'Row Number TextBox
    GetData
End Sub
Private Sub DisableSave() 'OK Button for registering new customers not implemented yet
    CommandButton1.Enabled = False
End Sub
Private Sub CommandButton2_Click() 'Cancel button
Unload Customers
End Sub
 
Upvote 0
Hi,
Give following a try & see if it does what you want.
Code has been taken from another I helped here with similar requirement and although untested,
should I hope, perform largely as required.

1 - make a backup of you workbook.

2 – you will need following named Commandbuttons on your form:

-NextRecord
-PrevRecord
-FirstRecord
-LastRecord
-SaveRecord

3 – discard existing form code & replace ALL following code in your forms CODE page:

Rich (BB code): 
Dim ws As Worksheet
Dim r As Long
Const FirstRow As Long = 2
Dim EventEnable As Boolean


Private Sub FirstRecord_Click()
    Navigate Direction:=xlFirst
End Sub


Private Sub LastRecord_Click()
    Navigate Direction:=xlLastCell
End Sub


Private Sub NextRecord_Click()
    Navigate Direction:=xlNext
End Sub


Private Sub PrevRecord_Click()
    Navigate Direction:=xlPrevious
End Sub


Private Sub CustomerID_Change()
   If Not EventEnable Then Exit Sub


    r = Me.CustomerID.ListIndex + 2
    
    Navigate Direction:=xlRowItem
End Sub


Private Sub RowNumber_Change()
    
    If Not EventEnable Then Exit Sub


    If IsNumeric(RowNumber.Text) Then
        r = Val(RowNumber.Text)
        If r >= FirstRow Then Navigate Direction:=xlRowItem
    Else
        Navigate Direction:=xlNone
    End If


End Sub


Private Sub UserForm_Initialize()
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    With Me.CustomerID
        .RowSource = ""
        .List = ws.Range("CDB").Value
    End With
    
    'start at first record
    Navigate Direction:=xlFirst
End Sub




Sub Navigate(ByVal Direction As XlSearchDirection)
    Dim i As Integer
    Dim LastRow As Long
    Dim ClearRecord As Boolean


    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Select Case Direction
    Case xlFirst
        r = FirstRow
    Case xlPrevious
        r = r - 1
        If r < FirstRow Then r = FirstRow
    Case xlNext
        r = r + xlNext
        If r > LastRow Then r = LastRow
    Case xlLastCell
        r = LastRow
    Case xlRowItem
        r = r
    Case xlNone
        ClearRecord = True
        r = 1
    End Select
    
    EventEnable = False
    'get record
    For i = 1 To UBound(ControlNames)
        Me.Controls(ControlNames(i)).Text = IIf(ClearRecord, "", ws.Cells(r, i).Text)
    Next i
    
    'set enabled status of navigate buttons
    Me.NextRecord.Enabled = r < LastRow
    Me.PrevRecord.Enabled = r > FirstRow
    Me.LastRecord.Enabled = Me.NextRecord.Enabled
    Me.FirstRecord.Enabled = Me.PrevRecord.Enabled
    Me.SaveRecord.Enabled = Not ClearRecord
   
    If Not ClearRecord Then Me.RowNumber.Text = FormatNumber(r, 0)
    EventEnable = True
End Sub

You will need to change the sheet name shown in RED where your data resides as required.
I have assumed that the first record starts in Row 2 but you can adjust where also shown in RED as required.
I have also assumed that CDB is a named range for your customer ID in Column 1. Again adjust as required.

4 – place following code in a STANDARD module:

Rich (BB code): 
 Option Base 1

Function ControlNames() As Variant
ControlNames = Array("CustomerID", "CustomerName", "Address1", "Address2", "Prefix", _
                    "Zip", "Country", "City", "Delivery1", "Delivery2", "DeliveryZip", _
                    "DeliveryTown", "Delivery_Terms_Point", "Base_Currency", _
                    "Region", "Contact", "Telephone", "Account", "VAT_Reg_no")
End Function

Not Option Base 1 statement which MUST sit at the top of the module outside of the function.

If all goes well, you should, when first open the form, be presented with first record. Selecting another record from combobox or entering record number in textbox should change the record in the form. Well, that’s the theory.

Hope helpful

Dave
 
Last edited:
Upvote 0
Just noticed a late change I made won't catch the out of range values input to the textbox.

replace the Navigate code with updated version:

Code: 
Sub Navigate(ByVal Direction As XlSearchDirection)
    Dim i As Integer
    Dim LastRow As Long
    Dim ClearRecord As Boolean


    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Select Case Direction
    Case xlFirst
        r = FirstRow
    Case xlPrevious
        r = r - 1
    Case xlNext
        r = r + xlNext
    Case xlLastCell
        r = LastRow
    Case xlRowItem
        r = r
    Case xlNone
        ClearRecord = True
        r = 1
    End Select
    
        If r < FirstRow Then r = FirstRow
        If r > LastRow Then r = LastRow
        
    EventEnable = False
    'get record
    For i = 1 To UBound(ControlNames)
        Me.Controls(ControlNames(i)).Text = IIf(ClearRecord, "", ws.Cells(r, i).Text)
    Next i
    
    'set enabled status of navigate buttons
    Me.NextRecord.Enabled = r < LastRow
    Me.PrevRecord.Enabled = r > FirstRow
    Me.LastRecord.Enabled = Me.NextRecord.Enabled
    Me.FirstRecord.Enabled = Me.PrevRecord.Enabled
    Me.SaveRecord.Enabled = Not ClearRecord
   
    If Not ClearRecord Then Me.RowNumber.Text = FormatNumber(r, 0)
    EventEnable = True
End Sub

Dave
 
Upvote 0
Hi Dave,
thanks, it worked perfectly navigating and selecting from the ComboBox!
But when adding the NewRecord procedure I run into problems as the form won't display a new empty record (preferably a new inserted line below the last record such the customer database name reference is expanded as well). I come as far as inserting the new line but the form doesn't refresh?
How to?
Kind regards
Mats
 
Upvote 0
You did not share that part of your code so I have no idea how it is interacting with solution I provided.

Post code & will see if can provide a solution.

Dave
 
Upvote 0
Here's the code. Please note I've changed some of the TextBox names (and the subsequently the array).
I also moved the LastRow count out to its own procedure (FindLastRow) and the variable to the declaration part.
Code: 
Private Sub NewRecord_Click() 'Add New record
    FindLastRow
    RowNumber.Text = FormatNumber(LastRow, 0)
    LastRow = LastRow + 1
    ActiveSheet.Columns(1).Rows(LastRow).Select
    ActiveCell.EntireRow.Insert
    SaveRecord.Enabled = True
    NewRecord.Enabled = False
End Sub
[HR][/HR]Private Sub Cancel_Click() 'Cancel button
    Unload Customers
End Sub
[HR][/HR]Private Sub SaveRecord_Click() 'Save Button for registering new customers
    PutData
    NewRecord.Enabled = True
End Sub
[HR][/HR]Private Sub PutData()
If IsNumeric(RowNumber.Text) Then
    r = CLng(RowNumber.Text)
Else
    MsgBox "Illegal row number"
    Exit Sub
End If

If r > 1 And r <= LastRow Then '>1
    Cells(r, 1) = CustomerID.Text
    Cells(r, 2) = CustomerName.Text
    Cells(r, 3) = Address1.Text
    Cells(r, 4) = Address2.Text
    Cells(r, 5) = Prefix.Text
    Cells(r, 6) = Zip.Text
    Cells(r, 7) = City.Text
    Cells(r, 8) = Country.Text
    Cells(r, 9) = Delivery1.Text
    Cells(r, 10) = Delivery2.Text
    Cells(r, 11) = DelZip.Text
    Cells(r, 12) = DelTown.Text
    Cells(r, 13) = DelPoint.Text
    Cells(r, 14) = BaseCurrency.Text
    Cells(r, 15) = Region.Text
    Cells(r, 16) = Contact.Text
    Cells(r, 17) = Telephone.Text
    Cells(r, 18) = Account.Text
    Cells(r, 19) = VATRegNo.Text
    Cells(r, 20) = RowNumber.Text

Else
    MsgBox "Invalid row number"
End If

End Sub
 
Upvote 0
You will need to post back ALL code with your changes before I can assist.

Dave
 
Last edited:
Upvote 0
First the Function from the standard Module:
Code: 
Option Base 1
Function ControlNames() As Variant
ControlNames = Array("CustomerID", "CustomerName", "Address1", "Address2", "Prefix", "Zip", _
                    "City", "Country", "Delivery1", "Delivery2", "DelZip", "DelTown", _
                    "DelPoint", "BaseCurrency", "Region", "Contact", "Telephone", _
                    "Account", "VATRegNo")
End Function

Then the code from the Form:

Code: 
Dim ws As Worksheet
Dim r As Long, LastRow As Long
Const FirstRow As Long = 2
Dim EventEnable As Boolean
[HR][/HR]
Private Sub FirstRecord_Click()
    Navigate Direction:=xlFirst
End Sub


[HR][/HR]Private Sub LastRecord_Click()
    Navigate Direction:=xlLastCell
End Sub


[HR][/HR]Private Sub NextRecord_Click()
    Navigate Direction:=xlNext
End Sub


[HR][/HR]Private Sub PrevRecord_Click()
    Navigate Direction:=xlPrevious
End Sub


[HR][/HR]Private Sub CustomerID_Change()
   If Not EventEnable Then Exit Sub

    r = Me.CustomerID.ListIndex + 2
    
    Navigate Direction:=xlRowItem
End Sub


[HR][/HR]Private Sub RowNumber_Change()
    If Not EventEnable Then Exit Sub

    If IsNumeric(RowNumber.Text) Then
        r = Val(RowNumber.Text)
        If r >= FirstRow Then Navigate Direction:=xlRowItem
    Else
        Navigate Direction:=xlNone
    End If
End Sub


[HR][/HR]Private Sub UserForm_Initialize()
    Set ws = ThisWorkbook.Worksheets("Customers")
    
    With Me.CustomerID
        .RowSource = ""
        .List = ws.Range("CDB").Value
    End With
    
    'start at first record
    Navigate Direction:=xlFirst
End Sub

[HR][/HR]Private Sub FindLastRow()
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
End Sub


[HR][/HR]Sub Navigate(ByVal Direction As XlSearchDirection)
    Dim i As Integer
'    Dim LastRow As Long
    Dim ClearRecord As Boolean

    FindLastRow
'    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Select Case Direction
    Case xlFirst
        r = FirstRow
    Case xlPrevious
        r = r - 1
    Case xlNext
        r = r + xlNext
    Case xlLastCell
        r = LastRow
    Case xlRowItem
        r = r
    Case xlNone
        ClearRecord = True
        r = 1
    End Select
    
    If r < FirstRow Then r = FirstRow
    If r > LastRow Then r = LastRow
        
    EventEnable = False
    'get record
    For i = 1 To UBound(ControlNames)
        Me.Controls(ControlNames(i)).Text = IIf(ClearRecord, "", ws.Cells(r, i).Text)
    Next i
    
    'set enabled status of navigate buttons
    Me.NextRecord.Enabled = r < LastRow
    Me.PrevRecord.Enabled = r > FirstRow
    Me.LastRecord.Enabled = Me.NextRecord.Enabled
    Me.FirstRecord.Enabled = Me.PrevRecord.Enabled
    Me.SaveRecord.Enabled = Not ClearRecord
   
    If Not ClearRecord Then Me.RowNumber.Text = FormatNumber(r, 0)
    EventEnable = True
End Sub

[HR][/HR]Private Sub NewRecord_Click() 'Add New record
    FindLastRow
    RowNumber.Text = FormatNumber(LastRow, 0)
    LastRow = LastRow + 1
    ActiveSheet.Columns(1).Rows(LastRow).Select
    ActiveCell.EntireRow.Insert
    SaveRecord.Enabled = True
    NewRecord.Enabled = False
End Sub

[HR][/HR]Private Sub Cancel_Click() 'Cancel button
    Unload Customers
End Sub

[HR][/HR]Private Sub SaveRecord_Click() 'Save Button for registering new customers
    PutData
    NewRecord.Enabled = True
End Sub

[HR][/HR]Private Sub PutData()
If IsNumeric(RowNumber.Text) Then
    r = CLng(RowNumber.Text)
Else
    MsgBox "Illegal row number"
    Exit Sub
End If

If r > 1 And r <= LastRow Then '>1
    Cells(r, 1) = CustomerID.Text
    Cells(r, 2) = CustomerName.Text
    Cells(r, 3) = Address1.Text
    Cells(r, 4) = Address2.Text
    Cells(r, 5) = Prefix.Text
    Cells(r, 6) = Zip.Text
    Cells(r, 7) = City.Text
    Cells(r, 8) = Country.Text
    Cells(r, 9) = Delivery1.Text
    Cells(r, 10) = Delivery2.Text
    Cells(r, 11) = DelZip.Text
    Cells(r, 12) = DelTown.Text
    Cells(r, 13) = DelPoint.Text
    Cells(r, 14) = BaseCurrency.Text
    Cells(r, 15) = Region.Text
    Cells(r, 16) = Contact.Text
    Cells(r, 17) = Telephone.Text
    Cells(r, 18) = Account.Text
    Cells(r, 19) = VATRegNo.Text
    Cells(r, 20) = RowNumber.Text

Else
    MsgBox "Invalid row number"
End If

End Sub

Regards
Mats
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Two values on userform but only send one value to worksheet
Replies
5
Views
351
ipbr21054
I
A
  • Question Question
Modifying code for message box on userform based on selected combobox
Replies
0
Views
174
Ali M
A
I
  • Question Question
Using VBA to create a dynamic Combo box population
Replies
1
Views
266
sxhall
S
M
  • Question Question
Dependent Listboxes
Replies
2
Views
214
mdiz777
M
N
  • Question Question
Getting Data from a Cell Then Changing the Data Finally Putting it in the Same Cell
Replies
1
Views
113
Jeffrey Mahoney
Jeffrey Mahoney

Share this page

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