Database form with two methods to select data

[Zebulon]

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?

 

[dmt32]

Hi,
I have had a good rummage in my archives and found a project that I helped another with that contains similar functionality to your requirement & although think I have adapted it to meet your requirement, I have not been able to properly test it so bugs may show up.

Ensure make a backup of your workbook.

Place ALL following codes in your Forms Code page ensuring that you first delete all existing codes with the same names.

 Dim ws As Worksheet
  Dim r As Long, LastRow As Long
Const FirstRow As Long = 2
Dim EventEnable As Boolean, IsNewCustomer As Boolean


'***************************************************************************************
'******************************NAVIGATE BUTTONS*****************************************
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


'***************************************************************************************
'*********************************New Record Button*************************************
Private Sub NewRecord_Click()
    Dim i As Integer


    IsNewCustomer = CBool(Me.NewRecord.Caption = Me.NewRecord.Tag)
    
    If IsNewCustomer Then Me.RowNumber.Text = FormatNumber(LastRow + 1, 0): Me.CustomerID.SetFocus
    
    ResetButtons IsNewCustomer
    
    Navigate Direction:=IIf(IsNewCustomer, xlNone, xlRowItem)
    
End Sub
'***************************************************************************************
'*********************************Save Record Button*************************************
Private Sub SaveRecord_Click()
    Dim i As Integer
    Dim msg As String
    
    'check all fields entered
    If Not IsComplete(Form:=Me) Then Exit Sub
    
    If IsNewCustomer Then
    
        NewCustomer Me, ws, FirstRow, r, LastRow
    
        ResetButtons Not IsNewCustomer
        
        msg = "New Customer Added"
        
    Else
    
        AddUpdateRecord Form:=Me, sh:=ws, RecordRow:=r
        
         msg = "Record Updated"
    
    End If
        
    'tell user what happened
    MsgBox msg, 48, msg
    
    IsNewCustomer = False
End Sub
'***************************************************************************************
'*********************************Cancel Button*************************************
Private Sub Cancel_Click()
    Unload Me
End Sub
'***************************************************************************************
'*********************************Customer ID ComboBox**********************************
Private Sub CustomerID_Change()
   If Not EventEnable Or IsNewCustomer Then Exit Sub


    r = Me.CustomerID.ListIndex + FirstRow
    
    Navigate Direction:=xlRowItem
End Sub
'***************************************************************************************
'*********************************Row Number TextBox************************************
Private Sub RowNumber_Change()
    
    If Not EventEnable Or IsNewCustomer 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


'***************************************************************************************
'*********************************Navigation********************************************


Sub Navigate(ByVal Direction As XlSearchDirection)
    Dim i As Integer
    Dim ClearForm As Boolean
    
    EventEnable = False
    
    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
        ClearForm = True
    End Select
    
    'ensure value of r stays within data range
    If r < FirstRow Then r = FirstRow
    If r > LastRow Then r = LastRow
    
    'get record
    For i = 1 To UBound(ControlNames)
         Me.Controls(ControlNames(i)).Text = IIf(ClearForm, "", ws.Cells(r, i).Text)
    Next i
    
    NavigationButtonsEnable ClearForm
    
    If Not ClearForm Then Me.RowNumber.Text = FormatNumber(r, 0)
    EventEnable = True
End Sub
'***************************************************************************************
'*********************************Button Settings***************************************
Sub NavigationButtonsEnable(Optional ByVal ClearForm As Boolean)
    'set enabled status of next previous buttons
    Me.NextRecord.Enabled = IIf(ClearForm, False, r < LastRow)
    Me.PrevRecord.Enabled = IIf(ClearForm, False, r > FirstRow)
    Me.LastRecord.Enabled = Me.NextRecord.Enabled
    Me.FirstRecord.Enabled = Me.PrevRecord.Enabled
End Sub


Sub ResetButtons(ByVal Status As Boolean)
    
    With Me.NewRecord
        .Caption = IIf(Status, "Cancel", .Tag)
        .BackColor = IIf(Status, &HFF&, &H8000000F)
        .ForeColor = IIf(Status, &HFFFFFF, &H0&)
    End With
    
    With Me.SaveRecord
        .Caption = IIf(Status, "Add New Customer", .Tag)
        .WordWrap = Status
        If .Height < 30 Then .Height = 30
        .BackColor = IIf(Status, &HFF00&, &H8000000F)
        .ForeColor = IIf(Status, &HFFFFFF, &H0&)
    End With
    
    Me.CustomerID.ShowDropButtonWhen = IIf(Status, fmShowDropButtonWhenNever, fmShowDropButtonWhenAlways)
    Me.RowNumber.Locked = Status
    NavigationButtonsEnable
End Sub


'***************************************************************************************
'**********************************Start Up*********************************************


Private Sub UserForm_Initialize()


    Set ws = ThisWorkbook.Worksheets("Customers")
    
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Me.SaveRecord.Tag = Me.SaveRecord.Caption
    Me.NewRecord.Tag = Me.NewRecord.Caption
    
    With Me.CustomerID
        .RowSource = ""
        .List = ws.Range("A" & FirstRow & ":A" & LastRow).Value
    End With
    
    'start at first record
    Navigate Direction:=xlFirst
End Sub

Place following codes in a STANDARD module:

 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


Function IsComplete(ByVal Form As Object) As Boolean
    Dim i As Integer
    For i = 1 To UBound(ControlNames)
        IsComplete = CBool(Len(Form.Controls(ControlNames(i)).Text) > 0)
        If Not IsComplete Then
            MsgBox "Please Complete All Fields", 16, "Entry Required"
            Form.Controls(ControlNames(i)).SetFocus
            Exit Function
        End If
    Next i
End Function




Sub AddUpdateRecord(ByVal Form As Object, ByVal sh As Object, ByVal RecordRow As Long)
    Dim i As Integer


    On Error GoTo myerror
    Application.EnableEvents = False
    'Add / Update Record
    For i = 1 To UBound(ControlNames)
        With Form.Controls(ControlNames(i))
        If Not sh.Cells(RecordRow, i).HasFormula Then
            'check if date value
            If IsDate(.Text) Then
                sh.Cells(RecordRow, i).Value = DateValue(.Text)
            Else
                sh.Cells(RecordRow, i).Value = .Text
            End If
        End If
        End With
    Next i
    
    sh.Cells(RecordRow, 20).Value = Val(Form.RowNumber.Text)
    
myerror:
Application.EnableEvents = True
'something went wrong tell user
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub




Sub NewCustomer(ByVal Form As Object, ByVal sh As Object, ByVal FirstRow As Long, RecordRow As Long, LastRow As Long)


        LastRow = LastRow + 1
        RecordRow = LastRow
        
        sh.Cells(RecordRow, 1).EntireRow.Insert
        
        AddUpdateRecord Form, sh, RecordRow
        
        'update combobox
        With Form.CustomerID
            .Clear
            .List = sh.Range("A" & FirstRow & ":A" & LastRow).Value
            .ListIndex = LastRow - FirstRow
        End With
        
End Sub

Hopefully, what I have done is correct and code is doing what you want.

Dave

 

[Zebulon]

Hi Dave,
it worked very well, thank you so much!
Cheers
Mats

 

[dmt32]

Hi Dave,
it worked very well, thank you so much!
Cheers
Mats

right first time - that's definitely a first for me.

Glad solution worked ok for you & thanks for feedback

Dave