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

I

ipbr21054

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

Code: 
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
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
.
Believe you posted the wrong code. As best I can determine, the posted code only provides warnings if certain TextBoxes or ComboBoxes are empty.
 
Upvote 0
Are you sure ?

Doesnt the code shown below do that red part ?

Code: 
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
[COLOR=#ff0000]            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)[/COLOR]
        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
 
Upvote 0
Actually its this part

Code: 
 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)
 
Upvote 0
So would this then be correct ?


Code: 
.Cells(Lastrow + 1, 7).Value = "TEST"
 
Upvote 0
My last post works fine but then my worksheet activate doesnt load that customer into my listbox.
reason being there is now text in the red cell.

Can you advise how we can get this code to also allow text in the red cell so the name is then placed in the listbox.

Code: 
Private Sub Worksheet_Activate()
Application.GoTo Sheets("POSTAGE").Range("A" & Rows.Count).End(xlUp).Offset(1, 0), True
ActiveWindow.SmallScroll UP:=14


Dim answer As Integer
 
answer = MsgBox("DO YOU WISH TO OPEN THE USERFORM", vbQuestion + vbYesNo + vbDefaultButton2, "POSTAGE OPEN USERFORM MESSAGE")
If answer = vbNo Then
  Exit Sub
Else
End If


Dim ws As Worksheet
Set ws = Sheets("POSTAGE")
Dim i As Integer
i = 1
Do Until i = 5000 ' <-- change number rows to check here
    If ws.Range("G" & i).Interior.Color = RGB(255, 0, 0) Then
        PostageTransferSheet.Show
        Exit Sub
    End If
i = i + 1
Loop


MsgBox "NO MORE PARCELS ARE AWAITING DELIVERY", vbInformation, "POSTAGE DATE TRANSFER SHEET MESSAGE"


End Sub
 
Upvote 0
In my post above #6 you will see that the cells which are rgb red are the target cells for this code.
What can you advise please so the code accepts rgb red cells with the word POSTED on them currently.
currently the red cells work no problem. If I then manually type POSTED in the same cells then nothing happens.
Remove the text and all working fine.
so I would like red cells with the work POSTED to allow the code to do its job.


thansk.
 
Upvote 0
UNTESTED HERE BUT I BELIEVE THIS WILL WORK FOR YOU :

Code: 
Option Explicit


Private Sub Worksheet_Activate()
Application.GoTo Sheets("POSTAGE").Range("A" & Rows.Count).End(xlUp).Offset(1, 0), True
ActiveWindow.SmallScroll UP:=14




Dim answer As Integer
 
answer = MsgBox("DO YOU WISH TO OPEN THE USERFORM", vbQuestion + vbYesNo + vbDefaultButton2, "POSTAGE OPEN USERFORM MESSAGE")
If answer = vbNo Then
  Exit Sub
Else
End If




Dim ws As Worksheet
Set ws = Sheets("POSTAGE")
Dim i As Integer
i = 1
Do Until i = 5000 ' <-- change number rows to check here
    If ws.Range("G" & i).Interior.Color = RGB(255, 0, 0) Then
[COLOR=#ff0000][B]        ws.Range("G" & i).Value = "POSTED"[/B][/COLOR]
        PostageTransferSheet.Show
        Exit Sub
    End If
i = i + 1
Loop




MsgBox "NO MORE PARCELS ARE AWAITING DELIVERY", vbInformation, "POSTAGE DATE TRANSFER SHEET MESSAGE"




End Sub
 
Upvote 0
Thanks but that doesnt load the name,if i remove the text from the cell POSTED then the names are loaded, put the text back nothing is loaded
 
Upvote 0
With the code is use doesnt there need to be If & And etc like.

Code: 
If ws.Range("G" & i).Interior.Color = RGB(255, 0, 0) And Has a value Then
PostageTransferSheet.Show
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
201
ipbr21054
I
I
  • Solved
Date on userform shows tomorros date NOT todays
Replies
1
Views
192
ipbr21054
I
K
  • Question Question
I was try to load data To List Box And Transfer data to Sheet2.... (Not work this userform)
Replies
4
Views
190
krunal123
K
J
  • Question Question
Excel VBA Print Name Tag from Userform
Replies
2
Views
343
Rhodie72
Rhodie72
I
  • Question Question
Worksheet value is updated only after userform is closed
2
Replies
13
Views
490
ipbr21054
I

Forum statistics

Threads
1,223,885
Messages
6,175,182
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top