If cell value is the same

[Corey ....]

I need a simple code to see if there are any duplicate values in column A of
sheet 1.
I need the code to search fromt he top of the sheet down.
If the first duplicated value is (.font.strikethrough)=True then i need ALL
other values that are duplicated(exactly the same) to be also changed to
..Font.Strikethrough=True.

If the first dulpicated value is NOT .Font>Strikethrough then the remaining
duplicate values are to be also Not .Font.Strikethrough.

How would i go about this ?

CTm

 

[Per Jessen]

Hi CTm

Try this code

Sub Dublets()
Dim StartCell As Range
Dim LastCell As Range
Dim TargetRange As Range
Dim mFormat As Boolean
Dim off As Integer
Dim FormatTest As Boolean

Set LastCell = Cells(Rows.Count, 1).End(xlUp)
Set StartCell = Range("A1")
Set TargetRange = Range(StartCell, LastCell)

off = 1
For Each cell In TargetRange
Do Until LastCell.Row = StartCell.Row + off
If cell.Value = cell.Offset(off, 0).Value Then
If FormatTest = False Then
If cell.Offset(off, 0).Font.Strikethrough = True Then
mFormat = False
Else
mFormat = True
End If
FormatTest = True
End If
cell.Offset(off, 0).Font.Strikethrough = mFormat
End If
off = off + 1
Loop
off = 1
Next
End Sub

Regards,
Per

 

[ctm]

Ended up with:
Application.ScreenUpdating = False
Dim lastcell As Long
Dim myrow As Long
lastcell = Worksheets("Sheet1").Cells(Rows.Count,
"A").End(xlDown).Row
With ActiveWorkbook.Worksheets("Sheet1")
For myrow = 2 To lastcell
If .Cells(myrow, 1) <> "" And .Cells(myrow, 1).Offset(-1,
0).Value = "" Then
If .Cells(myrow, 1).Offset(1, 0).Value = .Cells(myrow,
1).Offset(0, 0).Value Then
For i = 1 To 22
If .Cells(myrow, 1).Font.Strikethrough = True Then
.Cells(myrow, 1).Offset(i, 0).Font.Strikethrough = True
Else
If .Cells(myrow, 1).Font.Strikethrough <> True Then
.Cells(myrow, 1).Offset(i, 0).Font.Strikethrough = False
End If
End If
Next i
End If
End If
Next
End With
Application.ScreenUpdating = True


Ctm

 

[Dorothy]

Ended up with:
Application.ScreenUpdating = False
    Dim lastcell As Long
    Dim myrow As Long
       lastcell = Worksheets("Sheet1").Cells(Rows.Count,
"A").End(xlDown).Row
   With ActiveWorkbook.Worksheets("Sheet1")
        For myrow = 2 To lastcell
            If .Cells(myrow, 1) <> "" And .Cells(myrow, 1).Offset(-1,
0).Value = "" Then
                If .Cells(myrow, 1).Offset(1, 0).Value =.Cells(myrow,
1).Offset(0, 0).Value Then
                    For i = 1 To 22
                    If .Cells(myrow, 1).Font.Strikethrough = True Then
                    .Cells(myrow, 1).Offset(i, 0).Font..Strikethrough = True
                    Else
                    If .Cells(myrow, 1).Font.Strikethrough <> True Then
                    .Cells(myrow, 1).Offset(i, 0).Font..Strikethrough = False
                    End If
                    End If
                    Next i
                   End If
            End If
              Next
              End With
    Application.ScreenUpdating = True









- Show quoted text -

Dear Corey,

you can use Filord for this: www.filord.com

Regards/Dorothy