macro for finding formatted cells

[Guest]

Columns D to F contain some cells with two diagonal borders forming an X. I
want to find each formatted cell and enter "1" in it. I can do a simple
macro using Find but can't figure out how to get it to loop.

I'm fairly new to this sort of thing so really need a simple "copy'n'paste"
type answer.

Thanks for your help

 

[Tom Ogilvy]

Post the code that works to find 1 cell.

 

[Guest]

Hi Tom
Thanks for you rapid response.
I just used the record macro facility. This is what it gave me:

Columns("D:F").Select
With Application.FindFormat.Borders(xlDiagonalDown)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Application.FindFormat.Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=True).Activate

ActiveCell.FormulaR1C1 = "1"

End Sub

 

[Tom Ogilvy]

Sub AABBCC()
Dim rng As Range, rng1 As Range
Dim sAddr as String
Set rng1 = Columns("D:F")
With Application.FindFormat.Borders(xlDiagonalDown)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Application.FindFormat.Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Set rng = rng1.Find(What:="", After:=Range("D1"), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
rng.Select
If Not rng Is Nothing Then
sAddr = rng.Address
Do
rng.Value = 1
Set rng = rng1.Find(What:="", After:=rng, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
Loop While rng.Address <> sAddr
End If
End Sub

worked OK for me.

 

[Guest]

Fantastic! Thank you very much
--
Linda M

Sub AABBCC()
Dim rng As Range, rng1 As Range
Dim sAddr as String
Set rng1 = Columns("D:F")
With Application.FindFormat.Borders(xlDiagonalDown)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Application.FindFormat.Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Set rng = rng1.Find(What:="", After:=Range("D1"), _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
rng.Select
If Not rng Is Nothing Then
sAddr = rng.Address
Do
rng.Value = 1
Set rng = rng1.Find(What:="", After:=rng, _
LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=True)
Loop While rng.Address <> sAddr
End If
End Sub

worked OK for me.

--
regards,
Tom Ogilvy



--
Regards,
Tom Ogilvy

ActiveCell.FormulaR1C1 = "1"