Messagebox vbyesno remove input when vbno

B

Bandito1

Board Regular
Joined
Oct 18, 2018
Messages
233
Office Version
  1. 2016
Platform
  1. Windows
Hi all,

I got this code that checks, when "Y" or "y" is placed in column C, if the font color in column A is red or not
If it is red then a msgbox pops up.

When i press yes or no and remove the "Y" or "y" the code fires again. I get the messagebox again.
How do i prevent that?

Also, how to tell that when i answer vbNo the input removes?
So the "Y" or "y" is removed and the data that comes with it (when Y is filled in, the date of today is printed in column J


VBA Code: 
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
If Target.Value = "Y" Then
If Range("A" & i).Font.Color = RGB(255, 0, 0) Then


 AnswerYes = MsgBox("OReally?", vbQuestion + vbYesNo, "User Repsonse")

 If AnswerYes = vbYes Then
   Exit Sub
 Else
   'Exit Sub
 End If
End If
End If

End Sub
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
Your question and code are a bit confusing.
I do not see your code setting any values anywhere.

Can you post the ENTIRE code? It is important for us to see what event procedure you are running so we have a full understanding of how this code is being called.
And it would be extremely helpful if you could maybe post a small data sample and walk us through an actual example, and show us what you want to happen.
 
Upvote 0
Thank you for your feedback.

I will try it again.

When "Y" or "y" is placed in column C, and the font color of the data in column A is red, the msgbox should show.
At this moment the Msgbox appears even if the font color in column A is not red.

When someone presses on No in the messagebox the "Y" or "y" in column should be removed and the date in column I

Hope it's more clear now


Below is the entire code;

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Dim xRg As Range, xCell As Range
    Dim Uppercase, Lowercase
    On Error Resume Next
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("A:A")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 8) = vbNullString
            Else
                Target.Offset(0, 8) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("C:C")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 7) = vbNullString
            Else
                Target.Offset(0, 7) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("F:F")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
     If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("K:K")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("M:M")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("P:P")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("R:R")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("U:U")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("W:W")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("Z:Z")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
            End If
        Application.EnableEvents = True
        If (Target.Count = 1) Then
        Application.EnableEvents = False
    If (Not Intersect(Target, Me.Range("AB:AB")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
        End If
        End If
        Application.EnableEvents = True
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("AD:AD")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
            End If
        Application.EnableEvents = True
        End If
        End If
    If (Target.Count = 1) Then
        Application.EnableEvents = False
        If (Not Intersect(Target, Me.Range("AF:AF")) Is Nothing) Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
            Else
                Target.Offset(0, 1) = Date
            End If
            End If
        Application.EnableEvents = True
        End If

     If Target.Count > 1 Then Exit Sub
        If Not Intersect(Target, Me.Range("K:K,P:P,U:U,Z:Z,AD:AD")) Is Nothing Then
            If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
                Target.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlNone
                Target.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlNone
                Target.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlNone
                Target.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
                Range("C" & i).BorderAround ColorIndex:=3
            Else
                Target.Offset(0, 1) = Date
                Target.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 2).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
                Target.Offset(0, 2).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 3).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
                Range("C" & i).BorderAround ColorIndex:=3
            End If
    ElseIf Not Intersect(Target, Range("M:M,R:R,W:W,AB:AB,AF:AF")) Is Nothing Then
           If Target = vbNullString Then
                Target.Offset(0, 1) = vbNullString
                Target.Offset(0, 0).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 0).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 0).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 0).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 0).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
                Target.Offset(0, 0).Borders(xlEdgeLeft).Color = RGB(255, 0, 0)
                Target.Offset(0, 1).Borders(xlEdgeTop).LineStyle = xlContinuous
                Target.Offset(0, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
                Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
                Target.Offset(0, 1).Borders(xlEdgeTop).Color = RGB(255, 0, 0)
                Target.Offset(0, 1).Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
                Target.Offset(0, 1).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
            Else
                 Target.Offset(0, 1) = Date
                 Target.Offset(0, 0).Borders(xlEdgeTop).LineStyle = xlNone
                 Target.Offset(0, 0).Borders(xlEdgeBottom).LineStyle = xlNone
                 Target.Offset(0, 0).Borders(xlEdgeRight).Color = RGB(0, 0, 0)
                 Target.Offset(0, 0).Borders(xlEdgeLeft).Color = RGB(0, 0, 0)
                 Target.Offset(0, 1).Borders(xlEdgeTop).LineStyle = xlNone
                 Target.Offset(0, 1).Borders(xlEdgeBottom).LineStyle = xlNone
                 Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlNone
                 Target.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
                 
            End If
        End If
        
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
If Target.Value = "Y" Or "y" Then
If Range("A" & i).Font.Color = RGB(255, 0, 0) Then

AnswerYes = MsgBox("OReally?", vbQuestion + vbYesNo, "User Repsonse")

 If AnswerYes = vbYes Then
   Exit Sub
 Else
   Exit Sub
 End If
End If
End If

End sub


Test.xlsm
ABCDEFGHIJKLMN
3513GreenGrass30-sep-22x17-sep-22
Sheet1
Cells with Conditional Formatting
CellConditionCell FormatStop If True
A3:A1048573Expression=$F3<>""textNO
A3:AG1048573Expression=AND($A3<>"";MOD(SUBTOTAL(3;$A$3:$A3);2)=0)textNO
 
Upvote 0
Give this a try:
The intersect line is unchanged and just shows were the code goes.
The rest has been modified.

VBA Code: 
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub

If UCase(Target.Value) = "Y" And Range("A" & i).Font.Color = RGB(255, 0, 0) Then

    AnswerYes = MsgBox("OReally?", vbQuestion + vbYesNo, "User Repsonse")

    If AnswerYes = vbYes Then
      Exit Sub
    Else
        Target.Value = ""
        Me.Range("I" & Target.Row) = Date
        Exit Sub
    End If
End If
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Ambigious Name Detected: Reset
Replies
6
Views
236
aabrazil1
A
R
  • Question
Run-time error 6: Overflow on a Mac but not on Windows
Replies
1
Views
813
dmt32
D
S
  • Question
VBA to correct the sequential number for generated multiple workbooks
Replies
1
Views
383
Joe4
Joe4
C
  • Question
Mismatch error for macro when merged cell is cleared
Replies
1
Views
167
DanteAmor
DanteAmor
S
  • Question
BeforePrint
Replies
2
Views
328
saxon25
S

Forum statistics

Threads
1,214,522
Messages
6,120,022
Members
448,939
Latest member
Leon Leenders

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