VBA for data validation in 3rd column does not run. I need help.

R

RJQMAN

I have a complex program written six years ago, and I am working to update it. In the program, I am concerned about the sum of data entered into two ranges;

Column A5 - 15
Column B5 - 20
Column C5 contains a simple excel formula that adds column A and Column B and displays the sum = 35

If the user enters other numbers into column A and column B such that they total the same as a previous entry anywhere in the first 25 lines, I want to alert the user that the entry may be in error.

The original program used data validation and seemed to work fine. A typical cell formula would be

=if(countif(A$1:A$25,A5+B5)<=1,"True","False"

Another totally independent group of data is entered in cells A$30-B$50, etc, with over 60 different groups on the worksheet. I want to check that data against other entries in lines 30-50, but I do not want to check the data against entries in lines 1-25, and vice-versa.

I wrote the original program in Excel 2003, and it worked just fine. When Excel 2007 came out, the data validation became less dependable - many times a user could enter data that totaled the same in the first 25 lines, but for reasons I never understood, the entry did not trigger the alert in the Excel Data Validation.

I want to fix this in the revised program, so I have been testing a VBA solution someone provided for me back in 2007. It works pretty well, but the code that the person provided me (forgive me, I do not remember who it was)is dependent on the 'countif' evaluating the entire column of data to search for a duplicate, and I want the countif to evaluate the first 25 lines. I want to use a second countif to evaluate the next 25 lines, and so forththrough all 60 groupings on the sheet. I have been trying to modify this code without success for several days, and although it looks like it shouldwork, it never does! Just when I get everything to plug in in a way that appears correct, the code does not work at all. I am at a loss as to what to do.

Could someone please tell me how to make this work? I like using VBA, because I can vary the output messages as the program is used in different venues, so I would prefer to have the validation in VBA. I am using worksheet change to trigger the code.

Here is a portion of the code that I am working with (I took out some non-related items), which seems to work fine, except that it evaluates an entirecolumn instead of a portion of the column. I have the columns as variablesso that I do not have to rewrite the code for each of the sixty sections.

The real code has a counter that goes much higher, of course, but this hopefully is enough information for someone with more knowledge that I have to help me solve this issue. I have tried to substitute for the "Me.columns(TotalsColumn) and that is where I get into trouble. Not sure if I need the error escape lines or not, but I would rather fail to catch a duplicate than have the entire program crash, so I have them in there.

I cannot figure out how to do make it work though. Can someone please helpme?


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim TotalsColumn As Integer
Dim TestColumn1 As String
Dim TestColumn2 As String

Counter = 0
Dim range2 As String

Do Until Counter = 2

If Counter = 0 Then Const WS_RANGE As String = "A1:B25": TestColumn1 = "A": TestColumn2 = "B": TotalsColumn = 3
If Counter = 1 Then Const WS_RANGE As String = "A26:B50": TestColumn1 = "A": TestColumn2 = "B": TotalsColumn = 3
If Counter = 2 Then Const WS_RANGE As String = "D1:D25": TestColumn1 = "D": TestColumn2 = "E": TotalsColumn = 6

'( etc. for 59 more sections in various columns - six sections to a column)...

On Error GoTo ws_exit
If Target = 0 Then GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
If Application.CountIf(Me.Columns(TotalsColumn), Me.Cells(.Row,TestColumn1).Value + Me.Cells(.Row, TestColumn2).Value) = 1 Then
MsgBox "Valid Entry"
Else
On Error GoTo ws_exit
If MsgBox("Sum already used, accept anyway?", vbYesNo + vbQuestion) = vbNo Then .Value = ""
End If
End With
End If
Counter = Counter + 1
Loop

ws_exit:
Application.EnableEvents = True
End Sub
 
R

RJQMAN

I have been able to resolve the problem by several 12 hour days of trial and error. I am posting the solution here in case some others may face a similar difficulty.

I was able to develop a worksheet change macro that functioned, but it was too large for the whole sheet, and I received a 'Procedure Too Large' error.. After some experimentation and with the assistance of two very kind men who helped me (De Primor and Deepak Barnwal) on the Excel-Macros Google Group, I stumbled on a way to split the macro.

This a portion of the two macros that do the data validation, which consists of determining if there is a duplicate in a third column as a result of adding a number in the first column to a number in the second column, in case anyone on this group ever has a similar problem;

Private Sub Worksheet_Change(ByVal Target As Range)

Dim CurrentMessage As String
CurrentMessage = ThisWorkbook.Sheets("Enter Scores").Range("AI32").Value

Select Case True
'

Case Not Intersect(Target, Me.Range("AG68:AG107")) Is Nothing
Call CheckUsed(Target, Me.Range(Target.Address).Value, Me.Range(Target.Address).Offset(0, 1).Value, ("AI68:AI107"))
Case Not Intersect(Target, Me.Range("AH68:AH107")) Is Nothing
Call CheckUsed(Target, Me.Range(Target.Address).Value, Me.Range(Target.Address).Offset(0, -1).Value, ("AI68:AI107"))


Case Not Intersect(Target, Me.Range("AG116:AG135")) Is Nothing
Call CheckUsed(Target, Me.Range(Target.Address).Value, Me.Range(Target.Address).Offset(0, 1).Value, ("AI116:AI135"))
Case Not Intersect(Target, Me.Range("AH116:AH135")) Is Nothing
Call CheckUsed(Target, Me.Range(Target.Address).Value, Me.Range(Target.Address).Offset(0, -1).Value, ("AI116:AI135"))

' etc, for all of my groupings...

End Select
Application.EnableEvents = True
End Sub

' The following sub was developed just to keep the first sub from being to large for Excel to process. I did not know there was a limit, but of course, at first I exceeded it. I believe it is somewhere around 56K when compiled. Of course, I had no idea how large it would be when compiled (and I still don't really know), but I knew I had to split it somehow because I kept getting the error messages. Again by trial and error, and with their guidance, I figured out where I could split it up with the second sub below;

Private Sub CheckUsed(ByVal Target As Range, ByVal aadress As Variant, ByVal aadressoffset As Variant, ByVal Rng As String)
Application.EnableEvents = False
Dim CurrentMessage As String
CurrentMessage = Range("AI32").Value
If Application.CountIf(Range(Rng), (aadress + aadressoffset)) > 1 Then If MsgBox(CurrentMessage, vbYesNo + vbQuestion, "[Personal Heading - insertyour own if you copy this code]") = vbNo Then Range(Target.Address).Value = ""

End Sub

I still have not figured out why Excel's built-in data validation is not consistent in giving me a valid result with either validation forumla '=if(Countif($C$1:$C$20,$A1+$B1)<=1,"True","False")' or 'Countif($C$1:$C:20,)$A1+$B1))<=1' - I don't know if both of my attempts at a validation formula were not correct or what the problem was. My problem started when Excel 2007 came out - prior to that they seemed to work fine. After Excel 2007, sometimes one of these works at detecting a duplicate, sometimes neither oneworks at detecting a duplicate, and sometimes I get a nuisance error message when there was no duplicate. Going to VBA for my data validation has eliminated the problem, as far as I can tell anyway. If someone knows why neither of these formulas worked reliably in Excel2007 and later, I would appreciate knowing to increase my understanding of Excel. But for now, my problem has been solved.

Best wishes to all on the group.
 

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

Top