Data Validation Problem Work-Around needed
On Sep 18, 1:58 pm, "Bob Phillips" wrote:
No, it is two macros, as the code will do the same sort of thing over and
over again, so the second macro saves lots of repetitive code.
I have recut it to try and avoid NG wrap-around, so give this a whirl
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE_11 As String = "H1:H43" '<== change to suit
Const WS_RANGE_12 As String = "I1:I43" '<== change to suit
Const WS_RANGE_13 As String = "J1:J43" '<== change to suit
Const WS_RANGE_21 As String = "H52:H81" '<== change to suit
Const WS_RANGE_22 As String = "I52:I81" '<== change to suit
Const WS_RANGE_23 As String = "J52:J81" '<== change to suit
'etc.
Const WS_RANGE_81 As String = "K14:K43" '<== change to suit
Const WS_RANGE_82 As String = "L14:L43" '<== change to suit
Const WS_RANGE_83 As String = "M14:M43" '<== change to suit
'... add other ranges in groups of 3 as above ... and ...
On Error GoTo ws_exit
Application.EnableEvents = False
Select Case True
Case Not Intersect(Target, Me.Range(WS_RANGE_11)) Is Nothing Or _
Not Intersect(Target, Me.Range(WS_RANGE_12)) Is Nothing
Call CheckUsed(Target, _
Me.Range(WS_RANGE_11).Column, _
Me.Range(WS_RANGE_12).Column, _
Me.Range(WS_RANGE_13).Column)
Case Not Intersect(Target, Me.Range(WS_RANGE_21)) Is Nothing Or _
Not Intersect(Target, Me.Range(WS_RANGE_22)) Is Nothing
Call CheckUsed(Target, _
Me.Range(WS_RANGE_21).Column, _
Me.Range(WS_RANGE_22).Column, _
Me.Range(WS_RANGE_23).Column)
Case Not Intersect(Target, Me.Range(WS_RANGE_81)) Is Nothing Or _
Not Intersect(Target, Me.Range(WS_RANGE_82)) Is Nothing
Call CheckUsed(Target, _
Me.Range(WS_RANGE_81).Column, _
Me.Range(WS_RANGE_82).Column, _
Me.Range(WS_RANGE_83).Column)
'add other case statements for other 3 range groups
End Select
ws_exit:
Application.EnableEvents = True
End Sub
Private Sub CheckUsed(ByVal Target As Range, ByVal Col1 As Long, _
ByVal Col2 As Long, ByVal Col3 As Long)
Dim cellLink As Boolean
With Target
If Application.CountIf( _
Me.Columns(Col3), Me.Cells(.Row, Col1).Value + _
Me.Cells(.Row, Col2).Value) = 1 Then
ActiveWorkbook.Names.Add Name:="_cell_" & .Address, _
RefersTo:=True
Else
On Error Resume Next
cellLink = Me.Evaluate( _
ActiveWorkbook.Names("_cell_" & .Address(0, 0)).RefersTo)
On Error GoTo 0
If cellLink < True Then
If MsgBox("Sum already used, accept anyway?", _
vbYesNo + vbQuestion) = vbYes Then
ActiveWorkbook.Names.Add _
Name:="_cell_" & Me.Cells(.Row, Col1).Address(0, 0), _
RefersTo:=True
ActiveWorkbook.Names.Add _
Name:="_cell_" & Me.Cells(.Row, Col2).Address(0, 0), _
RefersTo:=True
Else
.Value = ""
End If
End If
End If
End With
End Sub
--
---
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my addy)
wrote in message
ps.com...
On Sep 18, 4:43 am, "Bob Phillips" wrote:
Here is some amended code.
I have tried to indicate where and how you wouldextend it for all of your
ranges
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE_11 As String = "H1:H43" '<== change to suit
Const WS_RANGE_12 As String = "I1:I43" '<== change to suit
Const WS_RANGE_13 As String = "J1:J43" '<== change to suit
Const WS_RANGE_21 As String = "H52:H81" '<== change to suit
Const WS_RANGE_22 As String = "I52:I81" '<== change to suit
Const WS_RANGE_23 As String = "J52:J81" '<== change to suit
'etc.
Const WS_RANGE_81 As String = "K14:K43" '<== change to suit
Const WS_RANGE_82 As String = "L14:L43" '<== change to suit
Const WS_RANGE_83 As String = "M14:M43" '<== change to suit
'... add other ranges in groups sof 3 as above ... and ...
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
p
On Error GoTo ws_exit
Application.EnableEvents = False
Select Case True
Case Not Intersect(Target, Me.Range(WS_RANGE_11)) Is Nothing Or _
Not Intersect(Target, Me.Range(WS_RANGE_12)) Is Nothing
Call CheckUsed(Target, _
Me.Range(WS_RANGE_11).Column, _
Me.Range(WS_RANGE_12).Column, _
Me.Range(WS_RANGE_13).Column)
Case Not Intersect(Target, Me.Range(WS_RANGE_21)) Is Nothing Or _
Not Intersect(Target, Me.Range(WS_RANGE_22)) Is Nothing
Call CheckUsed(Target, _
Me.Range(WS_RANGE_21).Column, _
Me.Range(WS_RANGE_22).Column, _
Me.Range(WS_RANGE_23).Column)
Case Not Intersect(Target, Me.Range(WS_RANGE_81)) Is Nothing Or _
Not Intersect(Target, Me.Range(WS_RANGE_82)) Is Nothing
Call CheckUsed(Target, _
Me.Range(WS_RANGE_81).Column, _
Me.Range(WS_RANGE_82).Column, _
Me.Range(WS_RANGE_83).Column)
'add other case statements for other 3 range groups
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
End Select
ws_exit:
Application.EnableEvents = True
End Sub
Private Sub CheckUsed(ByVal Target As Range, ByVal Col1 As Long, ByVal
Col2
As Long, ByVal Col3 As Long)
Dim cellLink As Boolean
With Target
If Application.CountIf( _
Me.Columns(Col3), Me.Cells(.Row, Col1).Value + _
Me.Cells(.Row, Col2).Value) = 1 Then
ActiveWorkbook.Names.Add Name:="_cell_" & .Address, _
RefersTo:=True
Else
On Error Resume Next
cellLink = Me.Evaluate( _
ActiveWorkbook.Names("_cell_" & .Address(0, 0)).RefersTo)
On Error GoTo 0
If cellLink < True Then
If MsgBox("Sum already used, accept anyway?", _
vbYesNo + vbQuestion) = vbYes Then
ActiveWorkbook.Names.Add _
Name:="_cell_" & Me.Cells(.Row, Col1).Address(0,
0),
_
RefersTo:=True
ActiveWorkbook.Names.Add _
Name:="_cell_" & Me.Cells(.Row, Col2).Address(0,
0),
_
RefersTo:=True
Else
.Value = ""
End If
End If
End If
End With
End Sub
--
---
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my
addy)
wrote in message
oups.com...
On Sep 17, 8:19 am, "Bob Phillips" wrote:
I would use Worksheet Change event.
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A:B" '<== change to suit
Dim cellLink As Boolean
On Error GoTo ws_exit
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If Application.CountIf(Me.Columns(3), Me.Cells(.Row,
"A").Value
+ _
Me.Cells(.Row, "B").Value) = 1 Then
ActiveWorkbook.Names.Add Name:="_cell_" & .Address,
RefersTo:=True
Else
On Error Resume Next
cellLink = Me.Evaluate(ActiveWorkbook.Names("_cell_" &
.Address(0, 0)).RefersTo)
On Error GoTo ws_exit
If cellLink < True Then
If MsgBox("Sum already used, accept anyway?",
vbYesNo
+
vbQuestion) = vbYes Then
ActiveWorkbook.Names.Add Name:="_cell_" &
.Address(0, 0), RefersTo:=True
Else
.Value = ""
End If
End If
End If
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub
'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.
--
---
HTH
Bob
(there's no email, no snail mail, but somewhere should be gmail in my
addy)
wrote in message
roups.com...
I am struggling with the following problem.
I have multiple groups of numerical information. Each group has 3
columns - which I will call column A, column B and column C. The
user
inputs column A and column B - column C simply adds column A and
column B. If the result of adding column A and column B is the same
as a previous
...
read more »- Hide quoted text -
- Show quoted text -
Hi Bob
I just cannot get it to work. I loaded the code into a blank
worksheet and then did some tests of data. At first it worked for a
few cells. Then I deleted the data in the cells, and entered some new
data. Now it did not work at all. Then as I worked down to some
cells that I had not used before, it started to give me the warning
when I entered the first of the two columns, even before there was a
total pending. I wish I understood the code - then I could de-bug it
without bothering you or anyone else, but I do not.
I then went down to row 51 and tried it - same stuff going on. It
pops up the message at odd times, and does not display the message
when the duplicate totals appear. Sigh. I could really use some help
in figuring out what is going on.
Thanks
|