LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #15   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default Can't figure out how to do this loop

It sounds to me like you might as well check each cell in the column that
changed to see if there are more than one instance in that column.

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim HowMany As Long
Dim myCell As Range
Dim myRng As Range

If Target.Cells.Count 1 Then
Exit Sub
End If

'clear existing colors???
Target.EntireColumn.Interior.ColorIndex = xlNone

Set myRng = Intersect(Target.EntireColumn, Sh.UsedRange)

For Each myCell In myRng.Cells
If myCell.Value = "" Then
'skip it
Else
HowMany = Application.CountIf(myRng, myCell.Value)
If HowMany 1 Then
myCell.Interior.ColorIndex = 4
End If
End If
Next myCell

End Sub

Jonathan Brown wrote:

At one point I had actually used conditional formatting just as you had
described which worked great but there was one problem. The issue was if I'd
use the autofill handle to drag across to the right or left on a row, the
formatting of the cell, including the fill color, would copy along with it.
I was hoping that by using code it would cause the spreadsheet to reevaluate
each column after using the autofill handle. I hope that makes sense.

I'm really close now though. I'm at a point where if there's two duplicate
cells in a row and I fix one of them then both duplicates will go back to
white. But if there's more than two, we'll say three for example, then if I
fix one of the duplicates then all of the duplicates go back to white. It'd
be nice if I were to fix one duplicate then the remaining two or more
duplicates would remain red until I fix each of them. Also, when I use the
autofill handle using this code I get a "data type mismatch" error.

Is there a way, If I were to use conditional formatting, to turn off the
"copying of the formatting" with the autofill handle?

"Dave Peterson" wrote:

Before you spend anymore time using code, is there a reason that you don't want
to use format|conditional formatting.

You can make sure that all the duplicates are shaded--no matter what's changed.

Select the range (say the entire columns A:X)
Then with A1 the Activecell
Format|conditional Formatting

Formula is:
=COUNTIF(A:A,A1)1
(and give it a nice pattern format)

====
Just as an aside, I wouldn't use the entire column--just use the rows that you
want to use (plus a few more for insurance!):

Say you select A1:X99
and with A1 the activecell
format|Conditional format

Formula is:
=COUNTIF(A$1:A$99,A1)1



Jonathan Brown wrote:

Dave,

After fiddling around with your code I'm really liking it. I would like to
change it a little bit so that if I fix one of the two duplicate cells it'll
put both of the two cells that were duplicates back to white. This is
assuming that there are only two duplicates. I guess if there's more than
two duplicates then it'll just change the one that I fix back to white and
leave the other duplicates in red.

I've got it almost working. Here's what I've got after fiddling with your
code:

----------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)

Dim HowMany As Long
Dim myCell As Range

'clear existing colors???
'Target.EntireColumn.Interior.ColorIndex = xlNone

If Target.Cells.Count 1 Then
Exit Sub
End If

If Target.Value = "" Then
Exit Sub
End If

If Target.Interior.ColorIndex = 3 Then
Target.Interior.ColorIndex = xlNone
End If

HowMany = Application.CountIf(Target.EntireColumn, Target.Value)

If HowMany = 1 Then
'ok, just the new value
Exit Sub
End If

For Each myCell In Intersect(ActiveSheet.UsedRange, Target.EntireColumn)

' If Target.Interior.ColorIndex = 3 Then
' Target.Interior.ColorIndex = xlNone
' End If
'
' If myCell.Interior.ColorIndex = 3 Then
' myCell.Interior.ColorIndex = xlNone
' End If

If myCell.Value = Target.Value Then
myCell.Interior.ColorIndex = 3
ElseIf myCell.Value < Target.Value Then
If myCell.Interior.ColorIndex = 3 Or Target.Interior.ColorIndex = 3
Then
myCell.Interior.ColorIndex = xlNone
Target.Interior.ColorIndex = xlNone
End If
End If

Next myCell

End Sub
----------------------------------------------------------------------------------------------
By the way, thanks for your help, I really appreciate it.

"Dave Peterson" wrote:

I only look through the single column.

Did you try my version or did you make changes?

If you have other cells that are shaded, it's not because of the code I
suggested.


Jonathan Brown wrote:

Dave,

The procedure you provided is working for finding duplicates and changing
the highlight color, but it'll still highlight if there's a duplicate on the
row. All I want is for it to find a duplicate in the column. If there's two
cells side by side with the same value then I don't want it to change the
color. but if I have two cells above and below each other then I do want it
to change it's color.

could you help me with that?

"Dave Peterson" wrote:

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim HowMany As Long
Dim myCell As Range

'clear existing colors???
Target.EntireColumn.Interior.ColorIndex = xlNone

If Target.Cells.Count 1 Then
Exit Sub
End If

If Target.Value = "" Then
Exit Sub
End If

HowMany = Application.CountIf(Target.EntireColumn, Target.Value)

If HowMany = 1 Then
'ok, just the new value
Exit Sub
End If

For Each myCell In Intersect(Sh.UsedRange, Target.EntireColumn)
If myCell.Value = Target.Value Then
myCell.Interior.ColorIndex = 4
End If
Next myCell

End Sub


Jonathan Brown wrote:

I'm trying to make a script that will run when I edit a cell. Once I've
edited the cell I want the script to go to the top of the column and then
check to see if that value already exists anywhere in the target column. If
it does exist already then i want it to highlight it in red as well as the
cell that I just edited.

It's going to be similar to the find duplicates in selected range
conditional formatting rule. But the selected range needs to be the target
column. If the same value exists in a different column then it shouldn't
even be concerned with it.

Here's what I have so far. I'm trying to use some sort of loop to cycle
through each cell in the target column and compare it to the value of the
cell that I just changed.

----------------------------------------------------------------------------------------------
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

tRow = Target.Row
Row = 1
tColumn = Target.Column

Cell1 = Sh.Cells(tRow, tColumn).Value

For Each cell In Columns(tColumn).Select

Cell2 = Sh.Cells(Row, tColumn).Value

If Cell1.Value = Cell2.Value Then

'.PatternColorIndex = x1Automatic
Sh.Cells(Cell2).Interior.ColorIndex = 4

End If

Row = Row + 1

Next

End Sub
--------------------------------------------------------------------------------------------

Can anyone help me out?

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson


--

Dave Peterson


 
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
HOW TO 'BLINK' A FIGURE INSTEAD OFF BOLDING THE FIGURE Nad.Engoor Excel Worksheet Functions 3 December 30th 08 03:04 PM
returning back to loop check condition without completing the loop ashish128 Excel Programming 13 April 3rd 08 12:53 PM
Loop to Filter, Name Sheets. If Blank, Exit Loop ryguy7272 Excel Programming 3 February 5th 08 03:41 PM
(Complex) Loop within loop to create worksheets klysell Excel Programming 1 March 20th 07 12:03 AM
Advancing outer Loop Based on criteria of inner loop ExcelMonkey Excel Programming 1 August 15th 05 05:23 PM


All times are GMT +1. The time now is 12:41 PM.

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

About Us

"It's about Microsoft Excel"