***Challenging Pop-up excel box dealing with user information***

S

Steve

I'm not sure if this is possible, but I hope it is. I'm fairly new to
working with VBA coding, but i'm sure someone is up to the challenge. Thanks!

I have this code which is all most 100% what I'm looking for. only problem
is I need what I hope will be a small adjustment/addition to it. Not sure
where it needs to go though. Please help.

Currently I have a code that when somebody goes in and overwrites a cell
with a formula in it, a box pops up asking for their name and reason for
overide. It then stores this information in a vaildation box.

What I still need:

What I need is a way to not have the vaildation box show up if a formula is
put back in the cell. The reason is because the same spreadsheet is used
each year. So every year there will be different cells that will be
overidden. Currently when you go to put a formula back in the cell it keeps
the validation box information from the change.

I'm thinking there is 2 ways this can be done, but I really don't know.

1. make an adjustment to the code where if a formula is put into the cell
the validation box disappears for that cell. (preferred way)

2. before putting a formula in the cell you must clear the cell of all
numbers and formulas - which will then make the validation box disappear.

Hope these ideas help. Your advice and help is greatly appreciated.

Here is the current code I have.

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)

Dim sReason1 As String
Dim sReason2 As String
Dim sUser As String
Dim dDate As Date
Dim sStatus As String

If ActiveSheet.Range("iv1").Value = 1 Then

Application.EnableEvents = False
sReason1 = InputBox("Enter Name (First, Last):")
sReason2 = InputBox("Enter the reason for the override:")
dDate = Date
sUser = Environ("username")
sStatus = "Date:" & dDate & " " & "Name:" & sReason1 & " " & "Reason:" &
sReason2
With Target.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop,
Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = sUser
.ErrorTitle = ""
.InputMessage = sStatus
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Else
'do nothing
End If

Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.HasFormula Then
Application.EnableEvents = False
ActiveSheet.Range("iv1").Value = 1
Else
ActiveSheet.Range("iv1").Value = 0
End If

Application.EnableEvents = True

End Sub
 
T

TomPl

In the "Else" part of you if statement you have "'do nothing".
Try replacing it with this:
If Target.HasFormula Then
With Target.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
.ShowInput = True
.ShowError = True
End With
End If

I think that will work.

PS I don't like the use of cell iv1 as a variable. I would be inclined to
use a public VBA variable in its place.
 
S

Steve

Tom,

One follow up question. Is it possible to automatically Fill Color the cell
that is changed from a formula to a number?

Steve
 
S

Steve

Just thought of another possibility (probably a better way to do it) Is it
possible that if the cell includes a validation box that it is automatically
fill colored?

Steve
 
T

TomPl

This should do it:

If Target.HasFormula Then
With Target.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
.ShowInput = True
.ShowError = True
End With
With Target.Interior
.ColorIndex = 44
.Pattern = xlSolid
End With
End If
 
T

TomPl

You could use language similar to my last response to set the color when you
set the validation.

Tom
 
S

Steve

Hey Tom,

The formula you gave me is working great! One question. I'm making a small
alteration and I was wondering what is the color index # for "no color"? I
was playing around with it and 00 is white, but i couldn't find anything that
is no color (google searches weren't helping much either). Let me know if
you have any ideas.

Thanks Tom!

Steve
 
T

TomPl

Try:

Target.Interior.ColorIndex = xlNone

Tom

Steve said:
Hey Tom,

The formula you gave me is working great! One question. I'm making a small
alteration and I was wondering what is the color index # for "no color"? I
was playing around with it and 00 is white, but i couldn't find anything that
is no color (google searches weren't helping much either). Let me know if
you have any ideas.

Thanks Tom!

Steve
Click to expand...
 
S

Susan

TomPI - i agree with you (i wrote the original coding). unfortunately
whenever i tried to set a boolean value with the worksheet selection_
change, it wouldn't carry over to the worksheet_change sub. i tried
a public variable but i couldn't make it stick, so to speak. in a
userform i would have made an invisible checkbox or something to
use as a boolean value, so that's how i decided to use a worksheet
cell. how would you have handled a variable that would carry over
between
the subs?
thanks for any ideas
:)
susan
 
S

Steve

Tom,

Still shows as if white when using xlNone.

Not a big deal though, I can live with that. You have helped me out
greatly! Thanks again for your help!

Steve
 
T

TomPl

That code sets the color to "No Color" for me. Make sure it is in the
correct place in the routine.

Tom
 
T

TomPl

I set up this Module Level Variable and it seems to work.

Option Explicit

Dim lngStatus As Long

Private Sub Worksheet_Change(ByVal Target As Range)

Dim sReason1 As String
Dim sReason2 As String
Dim sUser As String
Dim dDate As Date
Dim sStatus As String

If lngStatus = 1 Then 'ActiveSheet.Range("i1").Value = 1 Then

Application.EnableEvents = False
sReason1 = InputBox("Enter Name (First, Last):")
sReason2 = InputBox("Enter the reason for the override:")
dDate = Date
sUser = Environ("username")
sStatus = "Date:" & dDate & " " & "Name:" & sReason1 & " " & "Reason:" &
sReason2
With Target.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop,
Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = sUser
.ErrorTitle = ""
.InputMessage = sStatus
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Else
If Target.HasFormula Then
With Target.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
.ShowInput = True
.ShowError = True
End With
With Target.Interior
.ColorIndex = 44
.Pattern = xlSolid
End With
End If
End If

Application.EnableEvents = True
Debug.Print lngStatus
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)



If Target.HasFormula Then
Application.EnableEvents = False
'ActiveSheet.Range("i1").Value = 1
lngStatus = 1
Else
'ActiveSheet.Range("i1").Value = 0
lngStatus = 0
End If

Application.EnableEvents = True
Debug.Print lngStatus

End Sub

Tom
 
S

Steve

Susan/Tom,

Here's the final version of the code. Mostly a combination between what
both of you gave me. Thank you both for all your help. It works great!


Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)

Dim sReason1 As String
Dim sReason2 As String
Dim sUser As String
Dim dDate As Date
Dim sStatus As String

If ActiveSheet.Range("iv1").Value = 1 Then

Application.EnableEvents = False
sReason1 = InputBox("Enter Name (First, Last):")
sReason2 = InputBox("Enter the reason for the override:")
dDate = Date
sUser = Environ("username")
sStatus = "Date:" & dDate & " " & "Name:" & sReason1 & " " & "Reason:" &
sReason2
With Target.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop,
Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = sUser
.ErrorTitle = ""
.InputMessage = sStatus
.ErrorMessage = ""
.ShowInput = True
.ShowError = True

End With
With Target.Interior
.ColorIndex = 44
.Pattern = xlSolid
End With

Else

If Target.HasFormula Then
With Target.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
.ShowInput = True
.ShowError = True
End With
With Target.Interior
.ColorIndex = xlNone
.Pattern = xlSolid
End With
End If

End If

Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.HasFormula Then
Application.EnableEvents = False
ActiveSheet.Range("iv1").Value = 1
Else
ActiveSheet.Range("iv1").Value = 0
End If

Application.EnableEvents = True

End Sub
 
S

Steve

Hey guys!

The code is working great. I was wondering however, if it is possible to do
one last adjustment. This one is going to be pretty tricky i think.

Currently if a formula is entered into the cell or copy and pasted into the
cell, the orange highlight goes away and so does all the stored information
about how made the overide. Is it possible that if a formula is autofiltered
into a cell that it does the above too? If not, it's no big deal of having
to copy and paste into the cell, but I was just curious.

Thanks so much!

Steve
 
S

Susan

i don't exactly understand the question, and i don't know if you can
autofilter based on comments............... maybe you need to start a
new thread asking this new question.
:)
susan, bowing out gracefully
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
VBA-Table Word 2019 - Move a selected text, from a cell to the adjacent cell to its right, by pressing the ENTER key 0
Making a macro only work on certain files 2
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
From Excel to user form 0
Working outlook via vba code with xlsx - error 0
Remove Identical words 0

Top