Posted to microsoft.public.excel.misc
|
|
Data Validation Problem Work-Around needed
On Sep 19, 9:42 am, " wrote:
On Sep 19, 4:31 am, "Bob Phillips" wrote:
It assumes that the 3rd range in each group has the sum formula pre-loaded.
Is that true with your data?
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
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.
|