Compare cells for same values via VBA.

  • Thread starter Thread starter Lostguy
  • Start date Start date
L

Lostguy

When I push the "Print" macro button on a worksheet, the macro:

a. Checks that certain cells do not have duplicate data.
b. Autofits the rows.
c. Displays the Print dialogue so the sheet can be printed.

B. and C. work fine, but I am having trouble setting up A.

D21, D22, and D23 contain the same list of possible values via in-cell
dropdown: blank, dog, cat, chicken

If any of the values of D21, D22, or D23 are the same (3 out of 3, 2
out of 3, etc.) (but duplicate blanks are OK), stop the current macro,
put up a messagebox that says "You have cells that have the same data
in them. Please fix this and then repush the Print button!", you push
OK, and then the macro ends.

So

Dog, blank, blank is OK.
Dog, chicken, blank is OK
Dog, dog, blank is bad.
Dog, chicken, dog is bad.

Any help appreciated!

Thanks!
VR/Lost
 
Why not have the macro just fix it automatically??

If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.
 
Don,

The macro isn't supposed to fix it; the user is.

Maybe my question got lost in my example.

D21 contains a dropdown of years (blank, 2008, 2009, 2010)
D22 and D23 contain the same dropdown list.
The spreadsheet is being used to track duration of training.
So the user picks the year of training from D21. (2010)
If the training goes into the next year, the user selects that from
D22 (2011)
The training may go a third year, but probably not. So the user leaves
D23 blank.

The problem I am having is that some users put 2010 into D21 and D22,
which is not correct.

So before the sheet is printed, the user needs to look at the dates
and if the schooling crosses two years, the user needs to be change
D22 from 2010 to 2011.

If the schooling only crosses one year (2010), D22 needs to be a
blank.

The macro is being used to error check the user's entries in those 3
cells before the sheet is printed.

HTH

VR/Lost
 
OK,

Here's a start, but I still can't figure out how to allow blanks in
those cells. "If D21=D22 unless D21 or D22 is blank, then..." Any
ideas?

Private Sub CommandButton1_Click()
If (Range("d21").Value = Range("d22").Value) Or (Range("d22").Value =
Range("d23").Value) Or (Range("d21").Value = Range("d23").Value) Then
MsgBox "There are duplicate overlap FYs. Please correct then press the
Print button.", vbExclamation, "Duplicate overlap FYs!"
Else: MsgBox ("No dupes. OK to print")
'autofit and print macro go here
End If
MsgBox "Ending the macro."
End Sub

VR/Lost
 
When all else fails, rtfi. I said..............

If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.
 
Here's one from my standard library:

Function HasDups(RR As Range, _
Optional IgnoreEmpty As Boolean = False) As Boolean
Dim R As Range
For Each R In RR.Cells
If IgnoreEmpty = False Then
If Application.WorksheetFunction.CountBlank(RR) > 1 Then
HasDups = True
Exit Function
End If
End If
If R.Value <> vbNullString Then
If Application.WorksheetFunction.CountIf _
(RR, R.Value) > 1 Then
HasDups = True
Exit Function
End If
End If
Next R
HasDups = False
End Function

You can call this from other code with

Dim B As Boolean
B = HasDups(Range("D21:D32"), True)
Debug.Print B

Or you can call it directly from a worksheet cell:
=HasDups(D21:D23, TRUE)

The IgnoreEmpty parameter indicates whether the code should test empty
cells. If False or omitted, the code ignores empty cells. If True,
empty cells are tested, and if two or more empty cells exist in RR,
the function returns True. In your case, set it to True or omit it.

As a side note, you can do this with an array formula with COUNTIF:

=SUM(COUNTIF(D21:D23,D21:D23))>3

This is an array formula, so you must press CTRL SHIFT ENTER
rather than just ENTER when you first enter the formula and whenever
you edit it later. If you do this properly, Excel will display
the formula enclosed in curly braces { }. You do not type
in the braces -- Excel puts them in automatically. The
formula will not work properly if you do not enter it with
CTRL SHIFT ENTER. For much more information about array
formulas, see http://www.cpearson.com/Excel/ArrayFormulas.aspx.



Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]
 
A slightly better procedure is


Function HasDups(RR As Range, Optional IgnoreEmpty As Boolean = True)
As Boolean
Dim R As Range
If (IgnoreEmpty = False) And _
(Application.WorksheetFunction.CountBlank(RR) > 1) Then
HasDups = True
Exit Function
End If
For Each R In RR.Cells
If R.Value <> vbNullString Then
If Application.WorksheetFunction.CountIf _
(RR, R.Value) > 1 Then
HasDups = True
Exit Function
End If
End If
Next R
End Function


Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]



Here's one from my standard library:

Function HasDups(RR As Range, _
Optional IgnoreEmpty As Boolean = False) As Boolean
Dim R As Range
For Each R In RR.Cells
If IgnoreEmpty = False Then
If Application.WorksheetFunction.CountBlank(RR) > 1 Then
HasDups = True
Exit Function
End If
End If
If R.Value <> vbNullString Then
If Application.WorksheetFunction.CountIf _
(RR, R.Value) > 1 Then
HasDups = True
Exit Function
End If
End If
Next R
HasDups = False
End Function

You can call this from other code with

Dim B As Boolean
B = HasDups(Range("D21:D32"), True)
Debug.Print B

Or you can call it directly from a worksheet cell:
=HasDups(D21:D23, TRUE)

The IgnoreEmpty parameter indicates whether the code should test empty
cells. If False or omitted, the code ignores empty cells. If True,
empty cells are tested, and if two or more empty cells exist in RR,
the function returns True. In your case, set it to True or omit it.

As a side note, you can do this with an array formula with COUNTIF:

=SUM(COUNTIF(D21:D23,D21:D23))>3

This is an array formula, so you must press CTRL SHIFT ENTER
rather than just ENTER when you first enter the formula and whenever
you edit it later. If you do this properly, Excel will display
the formula enclosed in curly braces { }. You do not type
in the braces -- Excel puts them in automatically. The
formula will not work properly if you do not enter it with
CTRL SHIFT ENTER. For much more information about array
formulas, see http://www.cpearson.com/Excel/ArrayFormulas.aspx.



Cordially,
Chip Pearson
Microsoft MVP 1998 - 2010
Pearson Software Consulting, LLC
www.cpearson.com
[email on web site]





When I push the "Print" macro button on a worksheet, the macro:

a. Checks that certain cells do not have duplicate data.
b. Autofits the rows.
c. Displays the Print dialogue so the sheet can be printed.

B. and C. work fine, but I am having trouble setting up A.

D21, D22, and D23 contain the same list of possible values via in-cell
dropdown: blank, dog, cat, chicken

If any of the values of D21, D22, or D23 are the same (3 out of 3, 2
out of 3, etc.) (but duplicate blanks are OK), stop the current macro,
put up a messagebox that says "You have cells that have the same data
in them. Please fix this and then repush the Print button!", you push
OK, and then the macro ends.

So

Dog, blank, blank is OK.
Dog, chicken, blank is OK
Dog, dog, blank is bad.
Dog, chicken, dog is bad.

Any help appreciated!

Thanks!
VR/Lost
Click to expand...
Click to expand...
 
I'm not sure this is what you want, but try this one.

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = Range("D21:D23")
With Application
If .CountIf(rng, Range("D21")) > 1 Or _
.CountIf(rng, Range("D22")) > 1 Or _
.CountIf(rng, Range("D23")) > 1 Then
MsgBox "There are duplicate overlap FYs. Please correct then press the
Print button.", vbExclamation, "Duplicate overlap FYs!"
Else: MsgBox ("No dupes. OK to print")
'autofit and print macro go here
End If
End With
MsgBox "Ending the macro."
End Sub

keiji
 
Chip and Keiji,

Thanks! With my knowledge, I could only get so far with this, so your
help is really appreciated.

Outstanding assistance as usual!

VR/Lost
 
Back
Top