Advice for userform code

[ipbr21054]

Morning,

I have a userform which opens when i first come to the worksheet.
I then enter all the data in each TextBox & when i press a button the data is then entered into the worksheet.

Once the item has been delivered to the customer i then like to enter the date of its delivery.
At present i come to the worksheet,the userform opens,i then close the userform,look for the customer in the spreadsheet & enter the date in the field for that customer.

Long winded i agree.
So i have now put on the userform a CommandButton3

So this is how i think it should work but need some help with the code please.

All customers names are in column B
The delivered date will always be entered in column G

Once i click the CommandButton3 i should see a list of all the customers name from column B.
I select the customer in question, say TOM JONES row 123
I then enter a date like 19/02/2019
This date should then be entered into the worksheet & in the cell G123 alongside the customer TOM JONES.

Many thanks.

This is the current userform code.

Private Sub CommandButton1_Click()Cancel = 0
If TextBox2.Text = "" Then
    Cancel = 1
    MsgBox "Customer`s Name Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox2.SetFocus
ElseIf TextBox3.Text = "" Then
    Cancel = 1
    MsgBox "Item Description Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox3.SetFocus
ElseIf TextBox4.Text = "" Then
    Cancel = 1
    MsgBox "Tracking Number Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox4.SetFocus
ElseIf ComboBox1.Text = "" Then
    Cancel = 1
    MsgBox "Username Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox5.SetFocus
    
ElseIf OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Ebay Account", vbCritical, "POSTAGE TRANSFER SHEET"
    
ElseIf OptionButton4.Value = False And OptionButton5.Value = False And OptionButton6.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Origin", vbCritical, "POSTAGE TRANSFER SHEET"
    
End If


If Cancel = 1 Then
        Exit Sub
End If


Dim i As Long
Dim x As Long
Dim ctrl As Control
Dim LastRow As Long
LastRow = ThisWorkbook.Worksheets("POSTAGE").Cells(Rows.Count, 1).End(xlUp).Row
    


    
 With ThisWorkbook.Worksheets("POSTAGE")
    .Cells(LastRow + 1, 1).Value = TextBox1.Text: TextBox1.Value = ""
    .Cells(LastRow + 1, 2).Value = TextBox2.Text: TextBox2.Value = ""
    .Cells(LastRow + 1, 3).Value = TextBox3.Text: TextBox3.Value = ""
    .Cells(LastRow + 1, 5).Value = TextBox4.Text: TextBox4.Value = ""
    .Cells(LastRow + 1, 9).Value = ComboBox1.Text: ComboBox1.Value = ""
    .Cells(LastRow + 1, 4).Value = TextBox6.Text: TextBox6.Value = ""
    If OptionButton1.Value = True Then .Cells(LastRow + 1, 8).Value = "DR": OptionButton1.Value = False
    If OptionButton2.Value = True Then .Cells(LastRow + 1, 8).Value = "IVY": OptionButton2.Value = False
    If OptionButton3.Value = True Then .Cells(LastRow + 1, 8).Value = "N/A": OptionButton3.Value = False
    If OptionButton4.Value = True Then .Cells(LastRow + 1, 6).Value = "EBAY": OptionButton4.Value = False
    If OptionButton5.Value = True Then .Cells(LastRow + 1, 6).Value = "WEB SITE": OptionButton5.Value = False
    If OptionButton6.Value = True Then .Cells(LastRow + 1, 6).Value = "N/A": OptionButton6.Value = False
End With
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox2.SetFocus
TextBox1.Value = Now
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub
Private Sub CommandButton2_Click()
Unload PostageTransferSheet


End Sub
Private Sub DHL_Click()
ActiveWorkbook.FollowHyperlink Address:="http://www.dhl.co.uk/en/express/tracking.html", NewWindow:=True


End Sub
Private Sub HERMES_Click()
ActiveWorkbook.FollowHyperlink Address:="https://www.myhermes.co.uk/tracking-results.html", NewWindow:=True


End Sub
Private Sub LABEL_Click()
TrackingLabel.Show


End Sub
Private Sub ROYALMAIL_Click()
ActiveWorkbook.FollowHyperlink Address:="https://www.royalmail.com/track-your-item", NewWindow:=True


End Sub


Private Sub TextBox1_Change()
    TextBox1 = UCase(TextBox1)
End Sub
Private Sub TextBox2_Change()
    TextBox2 = UCase(TextBox2)
End Sub
Private Sub TextBox3_Change()
    TextBox3 = UCase(TextBox3)
End Sub
Private Sub TextBox4_Change()
    TextBox4 = UCase(TextBox4)
End Sub
Private Sub ComboBox1_Change()
    ComboBox1 = UCase(ComboBox1)
End Sub
Private Sub TextBox6_Change()
    TextBox6 = UCase(TextBox6)
End Sub
Private Sub CustomerSearchBox_Change()
'Modified  10/3/2018  5:51:42 AM  EDT
Dim SearchString As String
Dim SearchRange As Range
SearchString = CustomerSearchBox.Value
Dim LastRow As Long
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Set SearchRange = Range("B2:B" & LastRow).Find(SearchString, LookIn:=xlValues, lookat:=xlWhole)
If SearchRange Is Nothing Then MsgBox SearchString & "  Not Found": Exit Sub
SearchRange.Select
Unload Me
End Sub
Private Sub UserForm_Initialize()
'Modified  10/3/2018  5:51:42 AM  EDT
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
Dim Lastrowa As Long
Sheets("POSTAGE").Cells(8, 2).Resize(LastRow - 7).Copy Sheets("POSTAGE").Cells(1, 12)
Lastrowa = Sheets("POSTAGE").Cells(Rows.Count, "L").End(xlUp).Row
Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Sort key1:=Cells(1, 12).Resize(Lastrowa), order1:=xlAscending, Header:=xlNo
CustomerSearchBox.List = Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Value
Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Clear
Application.ScreenUpdating = True


'USERNAME COMBOBOX




TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox2.SetFocus
End Sub
Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Dim fndRng As Range, findString As String, i As Integer


If Me.TextBox2.Value = "" Then Exit Sub
findString = Me.TextBox2.Value


With Sheets("POSTAGE").Range("B:B")
    Set fndRng = .Find(What:=findString, LookIn:=xlValues, lookat:=xlWhole, _
                   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
                   
    If Not fndRng Is Nothing Then
        'what was entered already exists - alter the name until not found
        For i = 2 To 20
            findString = Me.TextBox2.Value & " " & i
            Set fndRng = .Find(What:=findString, LookIn:=xlValues, lookat:=xlWhole, _
                       SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            If fndRng Is Nothing Then Exit For
        Next i
        
        'message saying what name should be
        'MsgBox "The name to use is " & findString
        
        'enter that name into textbox 2
        With Me.TextBox2
            .Value = findString
            .SelStart = 0
            .SelLength = Len(.Text)
            .SetFocus
        End With
        
        'cancel moving out of text box
        Cancel = True
    End If
End With
    
End Sub

 

[ipbr21054]

Re: Advice for userform code please

Hi,
With that code i can still enter a date which then overwrites the dat that is present on the worksheet.

I have never seen the msg box "A date is present" shown when i try to trigger it.

 

[DanteAmor]

Re: Advice for userform code please

Then use this. Select record with date and preess OkButton1

Private Sub OkButton1_Click() 'Dantes code
    Dim sh As Worksheet
    Dim b As Range
    Dim wName As String, res As Variant
    
    If CustomerSearchBox2.ListIndex = -1 Then
        MsgBox "Must Select Customer", vbCritical, "DATE RECEIVED TRANSFER"
        Exit Sub
    End If
    
    If TextBoxDate.Value = "" Or Not IsDate(TextBoxDate.Value) Then
        MsgBox "Enter A Valid Date", vbCritical, "DATE RECEIVED TRANSFER"
        TextBoxDate.SetFocus
        Exit Sub
    End If
    
    wName = CustomerSearchBox2.List(CustomerSearchBox2.ListIndex)
    Set sh = Sheets("POSTAGE")
    Set b = sh.Columns("B").Find(wName, LookIn:=xlValues, lookat:=xlWhole)
    If Not b Is Nothing Then
        If sh.Cells(b.Row, "G").Value <> "" Then
            MsgBox "A date is present. Canceled process", vbCritical, "DATE RECEIVED TRANSFER"
        Else
            sh.Cells(b.Row, "G").Value = CDate(TextBoxDate.Value)
            MsgBox "Delivery Date Updated", vb, "DATE RECEIVED TRANSFER"
        End If
    End If
    CustomerSearchBox2 = ""
    TextBoxDate = ""
    TextBox2.SetFocus
End Sub

 

[ipbr21054]

Re: Advice for userform code please

@DanteAmor
Many thanks,i now have it working correctly.

Below is my edited code which is working well and now in use.
OKButton1 is now renamed DateTransferButton

If there is a date in the worksheet cell & the user tries to enter another date in the same cell i now see my message "Date In Cell Already. Please Check"
I press OK & TextBox7 is cleared."TextBox7 is where i enter date"

So to now add to this code Is it possible that after the TextBox7 is cleared the worksheet cell in question is then selected so the user can look at it.

Private Sub DateTransferButton_Click()'Dantes code
    Dim sh As Worksheet
    Dim b As Range
    Dim wName As String, res As Variant
    
    If ListBox1 = -1 Then
        MsgBox "Please Select A Customer", vbCritical, "Delivery Parcel Date Transfer"
        Exit Sub
    End If
    
    If TextBox7.Value = "" Or Not IsDate(TextBox7.Value) Then
        MsgBox "Please Enter A Valid Date", vbCritical, "Delivery Parcel Date Transfer"
        TextBox7 = ""
        TextBox7.SetFocus
        Exit Sub
    End If
    
    wName = ListBox1.List(ListBox1.ListIndex)
    Set sh = Sheets("POSTAGE")
    Set b = sh.Columns("B").Find(wName, LookIn:=xlValues, lookat:=xlWhole)
    If Not b Is Nothing Then
        If sh.Cells(b.Row, "G").Value <> "" Then
            MsgBox "Date In Cell Already. Please Check", vbCritical, "Delivery Parcel Date Transfer"
            TextBox7 = ""
        Else
            sh.Cells(b.Row, "G").Value = CDate(TextBox7.Value)
            MsgBox "Delivery Date Updated", vbInformation, "Delivery Parcel Date Transfer"
        End If
    End If
    ListBox1 = ""
    TextBox7 = ""
    TextBox7.SetFocus
End Sub

 

[ipbr21054]

If it’s easier / less code etc to write maybe just select the row in question?

 

[DanteAmor]

Re: Advice for userform code please

@DanteAmor
Many thanks,i now have it working correctly.

You're welcome and thanks for the feedback

 

[DanteAmor]

Re: Advice for userform code please

So to now add to this code Is it possible that after the TextBox7 is cleared the worksheet cell in question is then selected so the user can look at it.

Add following:

            TextBox7 = ""
            [COLOR=#ff0000]Cells(b.Row, "G").Select[/COLOR]

 

[ipbr21054]

Re: Advice for userform code please

Thanks,i did have something but it was in the wrong place