Apply text to a cell userform to worksheet in current working code

[ipbr21054]

Good morning,

The code in use is supplied below.
Currently when i press my Postage Sheet Transfer Button the values are added to my worksheet and the cell in column G is applied the interior RGB colour Red.

Please can you advise how i also have text in the same cell, so not only is it then shown as RED but also the word IN POST applied.

Have a nice day.

Private Sub PostageSheetTransferButton_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"
    ComboBox1.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 = ""
    .Cells(Lastrow + 1, 7).Interior.Color = RGB(255, 0, 0)
    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
    
        Dim colorHTML As String, r As String, g As String, b As String
        If MsgBox("HAS SECURITY MARK BEEN APPLIED ?", vbYesNo + vbExclamation, "PINK LIPSTICK MESSAGE") = vbYes Then
            colorHTML = "FF0099"
            r = WorksheetFunction.Hex2Dec(Left(colorHTML, 2))
            g = WorksheetFunction.Hex2Dec(Mid(colorHTML, 3, 2))
            b = WorksheetFunction.Hex2Dec(Right(colorHTML, 2))
            .Cells(Lastrow + 1, 4).Interior.Color = RGB(r, g, b)
        End If
        MsgBox "Customer Postage Sheet Updated", vbInformation, "SUCCESSFUL MESSAGE"
    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

 

[Logit]

.
File removed.

 

[ipbr21054]

@Logit
Did you see the huge drop down list I mentioned and supplied screen shot of.

 

[Logit]

.
Add this to the bottom of the Userform_Initialize macro :

Dim l As MSForms.ComboBox
Dim i As Long: i = 0
Set l = Me.NameForDateEntryBox


While i < l.ListCount
 If "" = l.List(i, 0) Then: l.RemoveItem (i): Else i = 1 + i
Wend

The entire Userform_Initialize macro will look like this :

Private Sub UserForm_Initialize()
  Dim cl As Range, rng As Range, lstrw As Long, LastRow As Long, Lastrowa As Long, cntr As Integer
  
  TextBox2.SetFocus
  Application.ScreenUpdating = False
  LastRow = Sheets("POSTAGE").Cells(Rows.Count, "B").End(xlUp).Row
  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
  
  cntr = 1
  With Sheets("POSTAGE")
    lstrw = .Range("B65536").End(xlUp).Row
    Set rng = .Range("B8:B" & lstrw)
    For Each cl In rng
      'If cl.Offset(0, 5).Value = "" Then Sheets("POSTAGE").Range("L" & cntr).Value = cl.Value: cntr = cntr + 1




      If cl.Offset(0, 5).Value = "POSTED" Then Sheets("POSTAGE").Range("L" & cntr).Value = cl.Value: cntr = cntr + 1 '<--- added this line




    Next


    If cntr = 1 Then
      MsgBox "ALL PARCELS HAVE NOW BEEN DELIVERED ", vbExclamation, "POSTAGE SHEET DATE TRANSFER MESSAGE"
      Unload PostageTransferSheet
    ElseIf cntr = 2 Then
      NameForDateEntryBox.AddItem .Range("L1").Value
    Else
   
      .Range("L1:L" & cntr - 1).Sort key1:=.Range("L1"), order1:=xlAscending, Header:=xlNo
      NameForDateEntryBox.List = .Range("L1:L" & cntr - 1).Value
      NameForDateEntryBox.List = Sheets("POSTAGE").Cells(1, 12).Resize(Lastrowa).Value
      


      '.Range("L1:L" & cntr - 1).Clear '<----- commented out this line




      TextBox2.SetFocus
    End If
  End With

[B][COLOR=#008000]'' NEW CODE ADDED IN RED ...[/COLOR][/B]
[B][COLOR=#ff0000]
Dim l As MSForms.ComboBox[/COLOR][/B]
[B][COLOR=#ff0000]Dim i As Long: i = 0[/COLOR][/B]
[B][COLOR=#ff0000]Set l = Me.NameForDateEntryBox[/COLOR][/B]
[B][COLOR=#ff0000]
[/COLOR][/B]
[B][COLOR=#ff0000]While i < l.ListCount[/COLOR][/B]
[B][COLOR=#ff0000] If "" = l.List(i, 0) Then: l.RemoveItem (i): Else i = 1 + i[/COLOR][/B]
[B][COLOR=#ff0000]Wend[/COLOR][/B]


  
  Application.ScreenUpdating = True
  TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
  TextBox7.Value = Format(CDbl(Date), "dd/mm/yyyy")
 
End Sub

 

[ipbr21054]

Thanks.
I will take a look tomorrow

 

[ipbr21054]

Many thanks works well.

 

[Logit]

You are welcome.

Cheers !