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,
Changing For i = 2 TO For i = 8 did the trick.

Now thats sorted can the first name in the list be shown each time you open the userform.
Example.
If i scroll the list and lets say leave it at DANTE AMOR,close & save the worksheet.
Next time i open the userform DANTE AMOR is still shown as opposed to the first name starting with A like Andy.


Many thanks for your time this is just what i needed.

 

[DanteAmor]

Re: Advice for userform code please

For that, I need to store the last selection in cell Z1.
Try the following:

Private Sub CommandButton1_Click()
    Dim sh As Worksheet
    Dim b As Range
    Dim wName As String
    
    If ListBox1.ListIndex = -1 Then
        MsgBox "Select customer name from list"
        Exit Sub
    End If
    
    If TextBox1.Value = "" Or Not IsDate(TextBox1.Value) Then
        MsgBox "Enter a valid date"
        TextBox1.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
        sh.Cells(b.Row, "G").Value = CDate(TextBox1.Value)
        MsgBox "Delivered date updated"
        ListBox1.ListIndex = -1
        TextBox1.Value = ""
    End If
End Sub


Private Sub ListBox1_Click()
    Set ws = Sheets("POSTAGE")
    ws.Range("L1").Value = ListBox1.ListIndex
End Sub


Private Sub UserForm_Activate()
    'ListBox1.RowSource = "B2:B" & Range("B" & Rows.Count).End(xlUp).Row
    Dim i As Long, j As Long, ws As Worksheet, nIndex As Variant
    Set ws = Sheets("POSTAGE")
    For i = 8 To ws.Range("B" & Rows.Count).End(xlUp).Row
        added = False
        For j = 0 To ListBox1.ListCount - 1
            Select Case StrComp(ListBox1.List(j), ws.Cells(i, "B").Value, vbTextCompare)
                Case 0: added = True: Exit For
                Case 1: added = True: ListBox1.AddItem ws.Cells(i, "B").Value, j
                Exit For
            End Select
        Next
        If added = False Then ListBox1.AddItem ws.Cells(i, "B").Value
    Next
    nIndex = ws.Range("L1").Value
    If nIndex <> "" And nIndex > 0 And IsNumeric(nIndex) Then
        If nIndex < ListBox1.ListCount Then
            ListBox1.Selected(nIndex) = True
        End If
    End If
End Sub

 

[ipbr21054]

Re: Advice for userform code please

That stayed the same.
I mean it did not go back to the begining it stayed on the last vied name

 

[ipbr21054]

Re: Advice for userform code please

Wait,

I see what has happened.

The worksheet is sorted by date in column A
This is the info,

First entry on worksheet is at cell A8
Date is 0201/2017
Customer is CHRIS BROUGH

ListBox1 on the userform sorts names from worksheet column B in order of A-Z
The first name on the worksheet is CHRIS BROUGH so this is what i see in ListBox1

Ive now sorted it thanks very much

 

[ipbr21054]

Re: Advice for userform code please

Follow up to my last message.
My worksheet is sorted by date in column A
This means column B where the names are shown are in no order.

What i then see now in the multiple code is that it gets the names from column B but as the sheet is date sorted it just shows the list as what my sheet shows.
If i sort my sheet by the names in column B then the listbox would be correct.

So this i think from memory is why i put that line of code in the initialize section as it takes column B sorts A-Z then the listbox1 is correct.

Did i explain that better for you.

 

[DanteAmor]

Re: Advice for userform code please

I do not understand, the program orders the names of column B, it is with this line : For i = 8 To ws.Range("B" & Rows.Count).End(xlUp).Row.

Always do the treatment with the data in column B, no matter what you have in column A.
So what do you need?

 

[ipbr21054]

Re: Advice for userform code please

Many thanks,its now all sorted.

Had a bad day thats all.

 

[DanteAmor]

Re: Advice for userform code please

Do not worry, let me know if you need anything else.

 

[ipbr21054]

Re: Advice for userform code please

Morning,
I would like a small edit to the code please.

Below is the working code in use & works well.

The edit that is required stops the date being overwritten should the cell already have a date in it.
Some of my staff manage to select the incorrect customer name from the list,THERE IS A DATE ALREADY IN PLACE FOR THIS CUSTOMER.
They then enter the date & that info is then written to the worksheet THUS REPLACING THE EXISTING DATE WITH THE NEW DATE.

The edit would be that if there is a date in the cell then show msg box message.
If there is no date then continue to add the date as normal.

The msg box should advise the user that a date is present,clicking ok on the msg box would stop the process and allow the user to then select the correct customer name & start again.

Private Sub CommandButton3_Click()'Dantes code
    Dim sh As Worksheet
    Dim b As Range
    Dim wName As String
    
    If ListBox1.ListIndex = -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.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
        sh.Cells(b.Row, "G").Value = CDate(TextBox7.Value)
        MsgBox "Delivery Date Updated", vbInformation, "Delivery Parcel Date Transfer"
        ListBox1.ListIndex = -1
        TextBox7.Value = ""
    End If
End Sub

Private Sub OkButton1_Click()'Dantes code
    Dim sh As Worksheet
    Dim b As Range
    Dim wName As String
    
    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
        sh.Cells(b.Row, "G").Value = CDate(TextBoxDate.Value)
        MsgBox "Delivery Date Updated", vb, "DATE RECEIVED TRANSFER"
    End If
    CustomerSearchBox2 = ""
    TextBoxDate = ""
    TextBox2.SetFocus
End Sub

 

[DanteAmor]

Re: Advice for userform code please

Check this

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
        res = vbYes
        If sh.Cells(b.Row, "G").Value <> "" Then
            res = MsgBox("A date is present. Confirm update ", vbQuestion & vbYesNo, "DATE RECEIVED TRANSFER")
        End If
        If res = vbYes Then
            sh.Cells(b.Row, "G").Value = CDate(TextBoxDate.Value)
            MsgBox "Delivery Date Updated", vb, "DATE RECEIVED TRANSFER"
        Else
            MsgBox "Canceled process"
        End If
        
    End If
    CustomerSearchBox2 = ""
    TextBoxDate = ""
    TextBox2.SetFocus
End Sub