ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,226
- Office Version
- 2007
- Platform
- Windows
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.
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.
Code:
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
