Data Validation Problem Work-Around needed

R

RJQMAN

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 result in that same group, then I want to alert the user
that the data input may be incorrect. It could be correct, but they
should double-check to be certain, as it is probably incorrect.

If the result of adding the two numbers created a duplicate in column
C, the message would state something like "CAUTION - you may have
entered the correct data, but double-check" and then give the option
to accept the data or make the correction, as in conventional data
validation.

I need the solution to be in real time, so I think VBA is out, as I
want the entry of the data to trigger the caution note within a few
seconds, and I do not know a way to trigger a Macro that is column-
specific. Also, once the data involved in a specific entry has been
examined and found to be OK, I do not want to force the user to re-
examine that data again.

Data validation would work perfectly for this problem if it could be
used on cells that are calculated, but of course, it cannot. I know
logically that there is a way to use data validation to do this by
examining the data calculated thus far, and then comparing this to the
entry the user makes in column A and alerting him if the entry he
makes in column B would cause an answer in column C that already
exists. But the programming to do this by brute force would be
extensive, if I could even figure it out and I am not sure, but
perhaps there are even internal limits in Excel that would prevent
adding up to 30 variables to the list to search from. Since I will
have about 90 lists, each with 30 sets of data, on a given
spreadsheet, it seems that brute force, while it might work, may be
hugely memory intensive.

However, since there is a logical answer, there must be a progamming
answer?? I just do not have enough knowledge to figure it out. Can
anyone help me?

Here is a brief example of how brute force might work logically;


A B C

2 7 9 (User enters the 2 and the 7 - Excel calculates 2
+ 7 = 9
3 (Progam now calculates that adding a 6 in
column B would create a duplicate in column C, so validation would
display a message if and only if a 6 was added in column B).
Say the user added a 5 - then we would have

A B C

2 7 9
3 5 8
4 (Program now calculates that adding a 4 in coluimn
B would create a duplicate (8) or adding a 5 in column B would also
create a duplicate in column C (9), so validation would display a
message if a 4 or 5 were added in column B).

I may be able to reduce the lists from 30 sets of data to around 10
sets of data, as that would work for most users - the 30 sets of data,
however, cover every possible need, if that would help.

Is there someone that can guide me in an efficient way to solve this
problem? I thank you very much in advance...
 
B

Bob Phillips

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)
 
D

Dave Peterson

I think I'd use an adjacent column (D?) and put a formula like:
=IF(COUNTIF(C:C,C1)>1,"Warning","ok")
 
R

RJQMAN

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)


















- Show quoted text -
Click to expand...

Hello - this works great - but I really do not understand the code
well enough to adapt it to the multiple groups and multiple
columns... How would I do that? For example;

Group 1

Range for 1st column is H14 - H43; range for 2nd column is I14 - I43,
and Range for 3rd column is J14 - J43

Group 2

Range for 1st column is H52-H81, 2nd column I52-I81, and 3rd column
J52-J81

Group 3 - 7 Same concept in same columns

Then we move to Group 8, which stacks 7 more groups in the next set of
columns

Group 8 1st column K14-K43, 2nd column L14 - L43, 3rd column M14 M43
and so forth...

There are 15 columns sets, and each column set has 7 groups in the
column. To complicate it even more, three column sets have 3 sets of
input data added together.

I am only concerned with comparing data WITHIN each group - not
external to the group. There are 105 groups in total, I think...

Sorry that my knowledge base is not deeper, but it is a shallow pool,
I am afraid. What would I have to do to make this work on all of
these groups?

I really very much appreciate the help.

Also, I thank Mr. Peterson. However, due to the construction of the
sheet, I do not have the luxury of an extra column - the sheet has to
be printed out later, and it barely fits the existing columns without
adding a blank column for the message...
 
B

Bob Phillips

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 ...
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

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)
 
R

RJQMAN

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 ...
<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

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)
















...

read more »- Hide quoted text -

- Show quoted text -
Click to expand...


HI Bob -

I have cut and pasted that text exactly, and now nothing works. In my
ignorance, I do not understand all that I am doing, and so I do not
know how to begin to trouble-shoot it.

When I pasted it, I had to join a couple of statements that were
truncated, but that semed to be just fine.
I ended up with two macros on the page. Was that your intent? I feel
as though I should be combining these two but I do not understand it
well enough to do so. Could you help me once again??

Thanks so much.
 
B

Bob Phillips

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)



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)
















...

read more »- Hide quoted text -

- Show quoted text -
Click to expand...


HI Bob -

I have cut and pasted that text exactly, and now nothing works. In my
ignorance, I do not understand all that I am doing, and so I do not
know how to begin to trouble-shoot it.

When I pasted it, I had to join a couple of statements that were
truncated, but that semed to be just fine.
I ended up with two macros on the page. Was that your intent? I feel
as though I should be combining these two but I do not understand it
well enough to do so. Could you help me once again??

Thanks so much.
 
R

RJQMAN

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)









...

read more »- Hide quoted text -

- Show quoted text -
Click to expand...

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
 
B

Bob Phillips

It assumes that the 3rd range in each group has the sum formula pre-loaded.
Is that true with your data?

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



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)









...

read more »- Hide quoted text -

- Show quoted text -
Click to expand...

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
 
R

RJQMAN

It assumes that the 3rd range in each group has the sum formula pre-loaded.
Is that true with your data?
Click to expand...


Yes, it was. The formula is very simple - In J1 there is a formula -
just= H1+I1, =H2+I2, etc. Just nothing happens. So frustrating. I
wish I better understood the code - if I did I am sure I could
troubleshoot it myself. Ugh.

The code worked fine originally, with just the one section defined.
It just acts crazy when I added the additional code to cover all of
the data sets.

To be certain, here is what I did;

I am testing the code in a blank new worksheet. I put the formula
into the cells, then put the code into the worksheet by going to VB,
then clicking on the worksheet, and placing the code. The top white
blocks defaulted to " (General) " in parantheses in the left hand
block, and " checkused " in the right hand block.

Just to be 1000% sure, here is my copy of the code, which came from
you, was transposed to the sheet, and then here it is back to
you...maybe something will jump off the screen to you as the
problem...

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
 
R

RJQMAN

Yes, it was. The formula is very simple - In J1 there is a formula -
just= H1+I1, =H2+I2, etc. Just nothing happens. So frustrating. I
wish I better understood the code - if I did I am sure I could
troubleshoot it myself. Ugh.

The code worked fine originally, with just the one section defined.
It just acts crazy when I added the additional code to cover all of
the data sets.

To be certain, here is what I did;

I am testing the code in a blank new worksheet. I put the formula
into the cells, then put the code into the worksheet by going to VB,
then clicking on the worksheet, and placing the code. The top white
blocks defaulted to " (General) " in parantheses in the left hand
block, and " checkused " in the right hand block.

Just to be 1000% sure, here is my copy of the code, which came from
you, was transposed to the sheet, and then here it is back to
you...maybe something will jump off the screen to you as the
problem...

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
Click to expand...

Bob Phillips - are you still out there? I still am struggling with
this darn code - can you possibly help? Feel free to e-mail me
directly. I just cannot get it to work. My e-mail is, of course (I
think it is in the header) RJQMAN and I am at G-mail.com. Thanks.
 

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

Conditional Data Validation 2
Conditional Data Validation Options 2
Transpose, but how? 0
Dynamic List Data Validation 5
Data Validation using Unique Values 2
Data Validation to exclude blank cells 6
Unusual Use for Data Validation? 1
Having Blank Cells, etc. ? 1

Top