Userform replacing txtbox with ComboBox question

[ipbr21054]

Afternoon,

I have a userform which has at present txtboxes for where we manually type data.
For various reasons we encounter problems & thinking of changing these txtboes to Comboboxes.

Changing them over is fine but im concerned with the code that will need to be updated.

I have shown below the full code from the form & just asking if its going to be an issue in respect of start from "Start from scratch or Its not that bad"

Many thanks & please advise.
Have a nice day.

 Dim ws As Worksheet Dim r As Long
 Dim EventsEnable As Boolean
 Const startRow As Long = 6


Private Sub ImageClose_Click()
    'close the form (itself)
    Unload Me
End Sub


Private Sub CloseUserForm_Click()
    'close the form (itself)
    Unload Me
End Sub


Private Sub ComboBoxCustomersNames_Change()
        If Not EventsEnable Then Exit Sub
'get record
    r = Me.ComboBoxCustomersNames.ListIndex + startRow - 1
    Navigate Direction:=0
End Sub


Private Sub ComboBoxCustomersNames_Update()
    With ComboBoxCustomersNames ' change as required
        .RowSource = ""
        .Clear
        .List = ws.Range("A6:A" & ws.Range("A" & Rows.Count).End(xlUp).Row).Value
    End With
End Sub


Private Sub DeleteRecord_Click()


Dim C As Range


With Sheets("DATABASE")
    Set C = .Range("A:A").Find(What:=txtCustomer.Value, _
                        After:=.Range("A5"), _
                        LookIn:=xlValues, _
                        lookat:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
End With


If Not C Is Nothing Then
    If MsgBox("Are you sure you want to delete the record for " & txtCustomer.Text & "?", vbYesNo + vbCritical) = vbYes Then
        Rows(C.Row).EntireRow.Delete
        MsgBox "The record for " & txtCustomer.Text & " has been deleted!"
    Else
        MsgBox "The record containing customer " & txtCustomer.Text & " was not deleted!"
    End If
Else
    MsgBox "There were no records containing customer " & txtCustomer.Text & " to be deleted"
End If


Set C = Nothing


Unload Me
End Sub


Private Sub NewRecord_Click()
    Dim i As Integer
    Dim IsNewCustomer As Boolean
    
    IsNewCustomer = CBool(Me.NewRecord.Tag)
    
        If Not IsNewCustomer Then
        If MsgBox("Are you sure you wish to cancel these new customer details?", 36, "Cancel New Customer Details") = vbNo Then Exit Sub
    End If
    
    Navigate Direction:=IIf(IsNewCustomer, xlNone, xlPrevious)


    'if new customer, add Date
    If IsNewCustomer Then
        Me.txtJobDate.Text = Format(Date, "dd/mm/yyyy")
        Me.txtCustomer.SetFocus
    End If
    
    ResetButtons IsNewCustomer


End Sub


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


Private Sub OpenInvoice_Click()


    Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\"
    
    If txtInvoiceNumber = "N/A" Or Len(txtInvoiceNumber) = 0 Then
                MsgBox "Invoice N/A For This Customer", vbExclamation, "N/A INVOICE NOTICE"
    Else
        If Len(Dir(FILE_PATH & txtInvoiceNumber.Value & ".pdf")) = 0 Then
            If MsgBox("Would You Like To Open The Folder ?", vbCritical + vbYesNo, "Warning Invoice is Missing.") = vbYes Then
                CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR COPY INVOICES\")
            End If
        Else
            CreateObject("Shell.Application").Open (FILE_PATH & txtInvoiceNumber.Value & ".pdf")
        End If
    End If
End Sub
Private Sub PrevRecord_Click()
    Navigate Direction:=xlPrevious
End Sub
Private Sub UpdateRecord_Click()


Dim C As Range
Dim i As Integer
Dim msg As String
If Not IsComplete(Form:=Me) Then Exit Sub
Dim IsNewCustomer As Boolean
'New Part
 Dim ctrl As MSForms.Control
    For Each ctrl In Me.Controls
        If TypeOf ctrl Is MSForms.TextBox Then ctrl.BackColor = RGB(255, 255, 255)
    Next ctrl
'End New part


    If Me.NewRecord.Caption = "CANCEL" Then
        With Sheets("DATABASE")
            Set C = .Range("A:A").Find(What:=txtCustomer.Value, _
                                After:=.Range("A5"), _
                                LookIn:=xlValues, _
                                lookat:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
        End With
        If Not C Is Nothing Then
              MsgBox "Customer already Exists, file did not update"
              Cells(C.Row, "Q").Value = TextBox1 '<<<<<<<<<<<<<<
              Exit Sub
        End If
    End If
    
    IsNewCustomer = CBool(Me.UpdateRecord.Tag)
       
    msg = "CHANGES SAVED SUCCESSFULLY"
        
    If IsNewCustomer Then
    'New record - check all fields entered
        r = startRow
        msg = "NEW CUSTOMER SAVED TO DATABASE"
        ws.Range("A6").EntireRow.Insert
        ResetButtons Not IsNewCustomer
        Me.NextRecord.Enabled = True
    End If
    
        On Error GoTo myerror
    Application.EnableEvents = False
    'Add / Update Record
    For i = 1 To UBound(ControlNames)
                        With Me.Controls(ControlNames(i))
            'check if date value
            If IsDate(.Text) Then
                ws.Cells(r, i).Value = DateValue(.Text)
            ElseIf i = 15 Then
            If .Text = "" Then
                     MsgBox .Name & " is empty!"
                     Exit Sub
                End If
                ws.Cells(r, i).Value = Val(.Text)
            Else
                ws.Cells(r, i).Value = UCase(.Text)
            End If
                ws.Cells(r, i).Font.Size = 11
                ws.Cells(r, "P").Font.Size = 16
        End With


    Next i
    
    If IsNewCustomer Then
        Call ComboBoxCustomersNames_Update
        Range("A6:Q6").Interior.ColorIndex = 6
        
        With Sheets("DATABASE")
            If .AutoFilterMode Then .AutoFilterMode = False
            x = .Cells(.Rows.Count, 1).End(xlUp).Row
                .Range("A5:Q" & x).Sort key1:=.Range("A6"), order1:=xlAscending, Header:=xlGuess
                Range("A6:Q6").Borders.LineStyle = xlContinuous
                Range("A6:Q6").Borders.Weight = xlThin
            
       End With
              
    End If
    
    ThisWorkbook.Save
    
    'tell user what happened
    MsgBox msg, 48, msg
    
    Set C = Nothing
    
myerror:
Application.EnableEvents = True
'something went wrong tell user
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
Unload Me


End Sub


Sub ResetButtons(ByVal Status As Boolean)
    
    With Me.NewRecord
        .Caption = IIf(Status, "CANCEL", "ADD NEW CUSTOMER TO DATABASE")
        .BackColor = IIf(Status, &HFF&, &H8000000F)
        .ForeColor = IIf(Status, &HFFFFFF, &H0&)
        .Tag = Not Status
    Me.ComboBoxCustomersNames.Enabled = CBool(.Tag)
    End With
    
    With Me.UpdateRecord
        .Caption = IIf(Status, "SAVE NEW CUSTOMER TO DATABASE", "SAVE CHANGES FOR THIS CUSTOMER")
        .Tag = Status
    End With
End Sub


Private Sub UserForm_Initialize()
    Set ws = ThisWorkbook.Worksheets("Database")
    
    ComboBoxCustomersNames_Update




    ResetButtons False
    'start at first record
    Navigate Direction:=xlFirst
    
End Sub


Sub Navigate(ByVal Direction As XlSearchDirection)
    Dim i As Integer
    Dim LastRow As Long
    
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    r = IIf(Direction = xlPrevious, r - 1, r + xlNext)
    
    'ensure value of r stays within data range
    If r < startRow Then r = startRow
    If r > LastRow Then r = LastRow
    
    'get record
    For i = 1 To UBound(ControlNames)
         Me.Controls(ControlNames(i)).Text = IIf(Direction = xlNone, "", ws.Cells(r, i).Text)
    Next i
    
    Me.Caption = "Database"
    
    'set enabled status of next previous buttons
    Me.NextRecord.Enabled = IIf(Direction = xlNone, False, r < LastRow)
    Me.PrevRecord.Enabled = IIf(Direction = xlNone, False, r > startRow)
    
    EventsEnable = False
    Me.ComboBoxCustomersNames.ListIndex = IIf(Direction = xlNone, -1, r - startRow)
    EventsEnable = True




End Sub

 

[Fluff]

Best bet is to make a copy of the workbook & then change the txtboxes & see what happens.
Bearing in mind that we have no idea which controls you are going to change, or how, it's very difficult to give an accurate answer.
For instance how & when are you going to populate the new comboboxes? Where are the values going to come from? Are they going to require an exact match and if not why change?

 

[ipbr21054]

Hi,
I will do that later on.
Looking on another form which has comboboxes under Properties, Row source, INFO!AY2:AY21

I will try this & see.

Thanks

 

[dmt32]

code refers to an array of control names. If you want to change some textboxes for comboboxes you will either have to give them the same names as the textboxes being replace OR update the array of ControlNames to reflect the new control names - if you don't, very likely that you will get an error.

For i = 1 To UBound(ControlNames)

As Fluff has mentioned, How you populate the comboboxes is another issue you will need to determine.

Dave

 

[ipbr21054]

Morning,
Did i understand post 4 correctly ?

I have replaced the textboxes with comboboxes.
I have then changed their names to the same as what the textbox originally was.

So combobox1 is now called txtcustomer.
I have then renamed all the other text boxes like so with the correct name.

Save, close & open database i see a message Could not find the specified object.
This debugged is shown in yellow

Me.Controls(ControlNames(i)).Text = IIf(Direction = xlNone, "", ws.Cells(r, i).Text)

Thanks

 

[dmt32]

Error suggests that you have not named one of your objects correctly. You need to check the array against your control names & update as required.

Dave

 

[ipbr21054]

Thanks you were correct & it was a slip of the finger on one name.
Quickly playing around i see it seems to work ok.

One thing i did notice is when i add a few extra items to the list the database does not update.
Example
Database row source currently INFO!B2:B57

I add the extra few lines to the list making it INFO!B2:B62

When i go back to the database & use the drop down list arrow the added items are not shown.
Looking at the Database row source i see its still INFO!B2:B57 thus did not update.

I assume row source is a fixed code & not able to update.

Is there a work around for me to get this sorted.
I think i am then completed.

Thanks

 

[dmt32]

You would have to update your coding to include the new range

I seldom if ever would use RowSource to populate a combobox.

Consider using a List property of the control

With Worksheets("Sheet1")
        Me.ComboBox1.List = .Cells(2, 2).Resize(.Cells(.Rows.Count, 2).End(xlUp).Row - 1, 1).Value
  End With

code should automatically size to the data in the range

Change Names shown in RED as required

Dave

 

[ipbr21054]

hmmm,
Not sure where i put that in my code.
Also do i copy the code above and edit the red part for every combobox in use ?

Thanks

 

[dmt32]

If you are changing the fundamentals of how your code has been working then probably yes would answer to your question.
If want to avoid this then perhaps Another way maybe that you could consider would be to create dynamic named ranges & have your rowsource property refer to them?

You would need to experiment to determine best approach for your project.

Dave