Can't figure out how to do this loop

[Jonathan Brown]

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

 

[Joel]

I didn't look at al the code but you can't pass the sht into the worksheet
change function. This function is defined by excel. the worksheet change
function must be place in the VBA sheet that you are going to use it on. If
it is used on more than one sheet then you need to put it on each sheet.
Because you kn ow which sheet it is being used on you don't have to reference
the sheet or the workbook.

 

[Jonathan Brown]

I've got that part working fine. The code runs whenever a cell is modified,
or whenever the sheet is changed. The part where the script is currently
choking is on the If sh.cells(cell1).value = sh.cells(cell2).value statement.
I'm getting an error saying "Run-time error '1004': application-defined or
object-defined error".

I've made some changes and it's working better but it's still giving me the
above error message. The code is now looking like below:

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

Cell1 = Sh.Cells(tRow, tColumn)

For Each cell In Sh.Cells(Row, tColumn)

Cell2 = Sh.Cells(Row, tColumn)

If Sh.Cells(Cell1) = Sh.Cells(Cell2) Then

Sh.Cells(Cell2).Interior.ColorIndex = 4
Sh.Cells(Cell1).Interior.ColorIndex = 4

End If

Row = Row + 1

Next

 

[Jonathan Brown]

I didn't look at al the code but you can't pass the sht into the worksheet
change function. This function is defined by excel. the worksheet change
function must be place in the VBA sheet that you are going to use it on. If
it is used on more than one sheet then you need to put it on each sheet.
Because you kn ow which sheet it is being used on you don't have to reference
the sheet or the workbook.

I've got that part working fine. The code runs whenever a cell is modified,
or whenever the sheet is changed. The part where the script is currently
choking is on the If sh.cells(cell1).value = sh.cells(cell2).value statement.
I'm getting an error saying "Run-time error '1004': application-defined or
object-defined error".

I've made some changes and it's working better but it's still giving me the
above error message. The code is now looking like below:

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

Cell1 = Sh.Cells(tRow, tColumn)

For Each cell In Sh.Cells(Row, tColumn)

Cell2 = Sh.Cells(Row, tColumn)

If Sh.Cells(Cell1) = Sh.Cells(Cell2) Then

Sh.Cells(Cell2).Interior.ColorIndex = 4
Sh.Cells(Cell1).Interior.ColorIndex = 4

End If

Row = Row + 1

Next

-----------------------------------------------------------------------------------------------

 

[Kent Prokopy]

Simple:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long

For x = 1 To Target.Row - 1

If Target.Value = Range(Cells(x, Target.Column).Address).Value Then
Cells(x, Target.Column).Interior.ColorIndex = 4
Target.Interior.ColorIndex = 4
End If

Next x

End Sub

 

[Dave Peterson]

This is the workbook_sheetchange event that goes under the ThisWorkbook module.

It's not the worksheet_change event which could be in any/all worksheets.

 

[Dave Peterson]

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

 

[Kent Prokopy]

This works too:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim x As Long

For x = 1 To Target.Row - 1

If Target.Value = Range(Cells(x, Target.Column).Address).Value Then
Cells(x, Target.Column).Interior.ColorIndex = 4
Target.Interior.ColorIndex = 4
End If

Next x

End Sub

 

[Jonathan Brown]

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?

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

 

[Kent Prokopy]

Did you test mine?

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]

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.

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?

 

[Jonathan Brown]

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.

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.

 

[Dave Peterson]

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

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

 

[Jonathan Brown]

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]

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

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?