macro for finding formatted cells

  • Thread starter Thread starter Guest
  • Start date Start date
G

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
 
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
 
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.
 
Fantastic! Thank you very much
--
Linda M


Tom Ogilvy said:
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"
Click to expand...
 
Back
Top