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

 

[ipbr21054]

Yes red cells with text then names are loaded

 

[Logit]

.
Made changes to the UserForm code :

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


      [B][COLOR=#ff0000]If cl.Offset(0, 5).Value = "POSTED" Then Sheets("POSTAGE").Range("L" & cntr).Value = cl.Value: cntr = cntr + 1[/COLOR][/B] [B][COLOR=#339933]'<--- added this line

[/COLOR][/B]
    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


[B][COLOR=#ff0000]      '.Range("L1:L" & cntr - 1).Clear [/COLOR][COLOR=#339933]'<----- commented out this line

[/COLOR][/B]
      TextBox2.SetFocus
    End If
  End With
  
  Application.ScreenUpdating = True
  TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
  TextBox7.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub

There is a lot of code in your workbook. I looked at the other code as well and hopefully these two changes won't affect any other part of your workbook code.

 

[ipbr21054]

Thanks for that,nice to end up with a working code.

Have a nice night

 

[Logit]

.
You are welcome. Glad to help.

 

[ipbr21054]

@Logit can i ask a question please.

When i click the drop down arrow for the listbox the drop down is huge.
Looking at the properties the LIST ROWS show 24
So if i have 3 names in the list the drop down is very long and i can drag the slider on the right.

In my original file the LIST ROWS was also 24 but the drop down would automatically resize itself to the amount of names within.

 

[Logit]

.
Go into the VBE (where you write the maco code) and display the UserForm (PostageTransferSheet).


Click on the dropdown combobox NameForDateEntryBox.


On the left where the properties are displayed for this control, locate
ListRows.


Change the number to 5.


Save / Close / Restart the workbook.

 

[ipbr21054]

I have done that BUT still the list is huge.

Also if i click a blank space in this huge empty list then todays date is put in cell G2 ???

 

[ipbr21054]

Take a look at these photos

REVISED USERFORM.

As you can see 3 names & a huge space below of maybe 200 blank entries.
Also you will see the grab handle to the right where you can then drag up / down through the list.

ORIGINAL USERFORM.
As you can see only the one entry.
So huge empty blank space below.
Also no grab handle slider on the right.

 

[Logit]

.
Here is a link to download my copy : https://www.amazon.com/clouddrive/share/TMezlVCTLHbBwwa3ZlOG11ODA6EhKTpxtrRa63XfseE

The workbook runs as expected here.

If the download above does not work for you something else is going on either with the workbook running on your computer ... or it is your computer itself.

 

[ipbr21054]

Please can you show a screenshot of the form from your pc etc