Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
detecting duplicate input in a cell | Excel Worksheet Functions | |||
detecting duplicate input in a cell | Excel Worksheet Functions | |||
detecting duplicate input in a cell | Excel Worksheet Functions | |||
How do I run sums from one worksheet to another? | Setting up and Configuration of Excel | |||
Duplicate P/N and sums | Excel Worksheet Functions |