Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 46
Default Detecting Duplicate Sums - Worksheet code


Hi - I really need some help. Bob Phillips, are you still out there??

I am trying hard to solve a problem. I have about 25 sets of data,
each 3 columns wide, and each with 30 entries.. Column 1 and column 2
in each of the 25 sets of data are entered by the user, and column 3
is calculated as the sum of column 1 and column 2. I want to be able
to alert the user if the sum in one row within a set is identical to
the sum of another row in the same set. If it is a duplicate, there
is probably, but not definitely a data entry error).

Bob Phillips was kind enough to provide the following worksheet code,
but I cannot get it to function. Bob, if you are out there, I do not
know what else to do.

To test Bob's code, I took a blank worksheet, entered the simple
formula H1+I1 into the J1 box, H2+I2 in the J2 box, etc. I then enter
data into H1 and I1, such as 4 and 2, which produces a 6 in J1. I
then enter data into H2 and I2, such as 3 and 3, which produces a 6 -
this time in J2. Now is when I want the cautionary box to appear. I
cannot get it to do so, and since I do not fully understand most of
the code Bob was kind enough to provide, I do not know how to
troubleshoot it. I have been working on trial and error basis for
several days, and I just cannot seem to make it work.

Here is the code Bob provided. I would really appreciate some help.
Thanks in advance...


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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
detecting duplicate input in a cell leo Excel Worksheet Functions 1 January 22nd 07 08:06 AM
detecting duplicate input in a cell leo Excel Worksheet Functions 0 January 22nd 07 07:29 AM
detecting duplicate input in a cell leo Excel Worksheet Functions 0 January 22nd 07 07:28 AM
How do I run sums from one worksheet to another? Mike Holliday Setting up and Configuration of Excel 1 January 4th 06 02:41 PM
Duplicate P/N and sums Steve ([email protected]) Excel Worksheet Functions 4 July 11th 05 11:25 PM


All times are GMT +1. The time now is 08:37 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"