Re: Data Validation Problem Work-Around needed

Tech-Archive recommends: Speed Up your PC by fixing your registry

On Sep 19, 9:42 am, "RJQ...@xxxxxxxxx" <RJQ...@xxxxxxxxx> wrote:
On Sep 19, 4:31 am, "Bob Phillips" <bob....@xxxxxxxxxxxxx> 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 work***. I put the formula
into the cells, then put the code into the work*** by going to VB,
then clicking on the work***, 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 ***, 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.

.

Quantcast