MsgBox Yes / No to make cell interior Hot Pink

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,731
Office Version
  1. 2007
Platform
  1. Windows
Afternoon,

I have in use the following code which transfers data from my userform to my worksheet.
Before i see the message "Customer Postage Sheet Updated" i am looking for a Yes / No Msgbox.

Where if No is selected then continue to show the "Customer Postage Sheet Updated" as normal

BUT

If Yes is selected then the background of the cell where the value from the userform texBox6 is going to be placed should then be an interior colour of #FF69B4 "Hot Pink" I would prefer to use the HTML code.

Then continue to show the "Customer Postage Sheet Updated" as normal






Code: 
Private Sub DateTransferButton_Click()'Dantes code
    Dim sh As Worksheet
    Dim b As Range
    Dim wName As String, res As Variant
    
    If NameForDateEntryBox = -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 = NameForDateEntryBox.List(NameForDateEntryBox.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 HAS BEEN ENTERED ALREADY !" & vbCrLf & "Click OK To Go Check It Out ", vbCritical, "Delivery Parcel Date Transfer"
            TextBox7 = ""
            Unload PostageTransferSheet
            Cells(b.Row, "G").Select
        Else
            sh.Cells(b.Row, "G").Value = CDate(TextBox7.Value)
            MsgBox "Delivery Date Updated", vbInformation, "Delivery Parcel Date Transfer"
        End If
    End If
    NameForDateEntryBox = ""
    TextBox7 = ""
    TextBox7.Value = Format(CDbl(Date), "dd/mm/yyyy")
End Sub
Private Sub DHLButton_Click()
ActiveWorkbook.FollowHyperlink Address:="http://www.dhl.co.uk/en/express/tracking.html", NewWindow:=True
End Sub
Private Sub HERMESButton_Click()
ActiveWorkbook.FollowHyperlink Address:="https://www.myhermes.co.uk/tracking-results.html", NewWindow:=True
End Sub
Private Sub labelsbUTTON_Click()
TrackingLabel.Show
End Sub
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 = ""
    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
[COLOR=#ff0000]    NEW MSGBOX HERE[/COLOR]
    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

My effort would be as follows but having issues,

Code: 
    If OptionButton6.Value = True Then .Cells(lastrow + 1, 6).Value = "N/A": OptionButton6.Value = False    
If MsgBox("SECURITY MARK APPLIED", vbYesNo + vbQuestion) = vbYes Then


[COLOR=#ff0000]**Not sure about TextBox6 & Pink code**[/COLOR]


Else


End If
    
    MsgBox "Customer Postage Sheet Updated", vbInformation, "SUCCESSFUL MESSAGE"

cOULD YOU PLEASE ASSIST,MANY THANKS
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Sort by date Sort by votes
The HTML color must be converted to RGB, put the desired color without the # symbol


Code: 
        'NEW MSGBOX HERE
        Dim colorHTML As String, r As String, g As String, b As String
        If MsgBox("SECURITY MARK APPLIED", vbYesNo + vbQuestion) = vbYes Then
            [COLOR=#ff0000]colorHTML [/COLOR]= "[COLOR=#800080]FF69B4[/COLOR]"
            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 = [COLOR=#0000ff]RGB[/COLOR](r, g, b)
        End If
        MsgBox "Customer Postage Sheet Updated", vbInformation, "SUCCESSFUL MESSAGE"
    End With
 
Upvote 0
One of my hates.

End With Without With

Code: 
    If OptionButton6.Value = True Then .Cells(lastrow + 1, 6).Value = "N/A": OptionButton6.Value = False    
      'NEW MSGBOX HERE
        Dim colorHTML As String, r As String, g As String, b As String
        If MsgBox("SECURITY MARK APPLIED", vbYesNo + vbQuestion) = vbYes Then
            colorHTML = "FF69B4"
            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
    
    MsgBox "Customer Postage Sheet Updated", vbInformation, "SUCCESSFUL MESSAGE"
[COLOR=#ff0000]End With[/COLOR]
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
Every "With" needs a matching "End With".
Check to make sure that you have the same number of both. If not, you either have an extra one that needs to be removed, or you need to add one of the other to match.
 
Upvote 0
ipbr21054 said:
One of my hates.
End With Without With
Click to expand...

I only put the add-on you asked for, you had to adapt it to your code, if you have difficulties I'll pass all the code:

Code: 
[COLOR=#008000]Private Sub PostageSheetTransferButton_Click()[/COLOR]
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
    
[B][COLOR=#ff0000]With [/COLOR][/B]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
    'NEW MSGBOX HERE

[COLOR=#0000ff]        Dim colorHTML As String, r As String, g As String, b As String[/COLOR]
[COLOR=#0000ff]        If MsgBox("SECURITY MARK APPLIED", vbYesNo + vbQuestion) = vbYes Then[/COLOR]
[COLOR=#0000ff]            colorHTML = "FF69B4"[/COLOR]
[COLOR=#0000ff]            r = WorksheetFunction.Hex2Dec(Left(colorHTML, 2))[/COLOR]
[COLOR=#0000ff]            g = WorksheetFunction.Hex2Dec(Mid(colorHTML, 3, 2))[/COLOR]
[COLOR=#0000ff]            b = WorksheetFunction.Hex2Dec(Right(colorHTML, 2))[/COLOR]
[COLOR=#0000ff]            .Cells(lastrow + 1, 4).Interior.Color = RGB(r, g, b)[/COLOR]
[COLOR=#0000ff]        End If[/COLOR]


    MsgBox "Customer Postage Sheet Updated", vbInformation, "SUCCESSFUL MESSAGE"
[B][COLOR=#ff0000]End With[/COLOR][/B]
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox2.SetFocus
TextBox1.Value = Now
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
[COLOR=#008000]End Sub[/COLOR]
 
Upvote 0
Thanks very much for that guys,works well.

Im an idiot as you know so i will start a new post.

Thanks again
 
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
202
ipbr21054
I
I
  • Solved
Msgbox is shown whether file is saved or not
Replies
4
Views
252
Alex Blakenburg
A
I
  • Question Question
Find customer in column & link to his pdf
2
Replies
16
Views
605
NoSparks
N
I
  • Solved
Code moves worksheets columns to the left thus not showing column A
Replies
5
Views
197
Peter_SSs
Peter_SSs
I
  • Solved
Open userform in another worksheet
Replies
5
Views
354
ipbr21054
I

Forum statistics

Threads
1,223,886
Messages
6,175,189
Members
452,616
Latest member
intern444

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