HI Bill,
The explanation of your code does make sense now!
> It sounds like copying the CFs by themselves is not easy. I gave up.
If you still want to try copying purely the CF's, try the following (watch
out for line-wrap) -
Sub Test()
Dim rSource As Range
Dim rDest As Range
If ActiveCell Is Nothing Then Exit Sub
Set rSource = ActiveSheet.Range("B2")
Set rDest = ActiveSheet.Range("D2

10")
CopyCF rSource, rDest
End Sub
Sub CopyCF(rSource As Range, rDest As Range)
Dim vIntFmts(0 To 2), vFontFmts(0 To 7), vBdrFmts(1 To 4, 0 To 2)
Dim f1 As String, f2 As String
Dim nOp As Long, nType As Long
Dim fc As FormatCondition
' check rSource is a single cell and has FC
If rSource.Count > 1 Or _
rSource(1).FormatConditions.Count = 0 Then
Exit Sub
End If
rDest.FormatConditions.Delete
For Each fc In rSource.FormatConditions
Erase vIntFmts: f2 = ""
nType = fc.Type
If nType = 2 Then
nOp = 0
Else
nOp = fc.Operator
End If
f1 = Application.ConvertFormula(fc.Formula1, xlA1, xlR1C1)
f1 = Application.ConvertFormula(f1, xlR1C1, xlR1C1, , ActiveCell)
On Error Resume Next
f2 = fc.Formula2
If Len(f2) Then
f2 = Application.ConvertFormula(f2, xlA1, xlR1C1)
f2 = Application.ConvertFormula(f2, xlR1C1, xlR1C1, ,
ActiveCell)
End If
On Error GoTo 0
With fc.Interior
vIntFmts(0) = .ColorIndex
vIntFmts(1) = .Pattern
vIntFmts(2) = .PatternColorIndex
End With
With fc.Font
' trap any/all of following to vFontFmts if anticipated required
'Bold, Colorindex, Italic, Name, Size, StrikeThrough, Superscript, Underline
End With
With fc.Borders
'loop .Item(1) to .Item(4)
' trap any/all of following to vBdrFmts if necessary
' LineStyle, Weight, Colorindex
End With
With rDest.FormatConditions.Add(nType, nOp, f1, f2)
With .Interior
If Not IsNull(vIntFmts(0)) Then .ColorIndex = vIntFmts(0)
If Not IsNull(vIntFmts(1)) Then .Pattern = vIntFmts(1)
If Not IsNull(vIntFmts(2)) Then .PatternColorIndex = vIntFmts(2)
End With
' similarly apply Font & Border formats if trapped
End With
Next
End Sub
Include Font & Border formats if/as required.
As written, should be OK to copy CF in one cell to a block of cells BUT only
if the can do the same manually. AS mentioned before that means
relative/absolute addressing should be correct, which otherwise might not be
necessary.
The main difficulty above is getting those ConvertFormula's correct. In a
light test all seemed OK with a mixture of CF types & relative/absolute
addresses, but test thoroughly. I didn't test copying CF's NOT on the
activesheet, and anticipate a bit more work to cater for that if necessary.
Regards,
Peter T
"bstobart" <(E-Mail Removed)> wrote in message
news:782255CB-DAF3-4711-B18B-(E-Mail Removed)...
> Peter,
>
> You commented:
> "Not sure why you are copying formats after CF's (which will remove CF's)
> rather than other way round, (not that you could do what you are
attempting
> to do)."
>
> Notice that the inner loop in my code is intended to copy the CFs from the
> Destination Cell to the Source Cell, then I copy the entire Source Cell to
> the Destination Cell. In this way I wanted the end result to have the
rich
> text formatting of the source cell but the CFs from the Destimation cell.
>
> It sounds like copying the CFs by themselves is not easy. I gave up.
> Instead I have decided to split the destination cells into two groups:
those
> with conditional formats and those without. When a destination cell has
CFs
> I'm copying the source cell using PasteValues, when it does not have CFs
I'm
> copying the source cell using PasteAll. This is reasonable workaround for
my
> purposes, most of the time.
>
> --Bill
>
> "Peter T" wrote:
>
> > I'm confused trying to relate what you describe with your pseudo code,
> > ambiguous. Not sure why you are copying formats after CF's (which will
> > remove CF's) rather than other way round, (not that you could do what
you
> > are attempting to do).
> >
> > One way to interpret what you are want would imply simply pastespecial
> > formats for both your 'rich text' and CF formats, but I take it that's
not
> > what you want.
> >
> > Anyway, looking only at the subject line, you would indeed need to parse
out
> > the conditions & formats if you don't want to copy any other formats.
Can be
> > done but relative formulas require particular attention, eg A$1 is
partially
> > relative and can't simply be copied from a CF formula in one cell to
another
> > without multiple conversions.
> >
> > Do you want to copy a CF from a single source cell to a destination of
> > multiple cells, but not other formats. If so, all formulas in the
source
> > CF's would need to be carefully prepared in terms of relative and
absolute
> > such that all would work as expected if doing a manual pastespecial
> > formats..
> >
> > Regards,
> > Peter T
> >
> >
> > "bstobart" <(E-Mail Removed)> wrote in message
> > news:19464D92-2DC6-44E3-94C0-(E-Mail Removed)...
> > > I'm trying to copy a large number of conditional formats from one set
of
> > > cells to another. I don't want to explicitly define the formatting in
> > VBA,
> > > but rather take it from an existing set of cells. Is there a way to
do
> > this
> > > without parsing out all the various components of a given conditional
> > format?
> > >
> > > I tried the following, which failed miserably:
> > >
> > > Dim intFormCondNum As Integer
> > >
> > > ' Loop over a set of Source/Destination cell pairs
> > >
> > > With SourceCell
> > >
> > > .Worksheet.Unprotect
> > > DestCell.Worksheet.Unprotect
> > >
> > > ' ******** This part doesn't work**********
> > > If DestCell.FormatConditions.Count > 0 Then
> > > For intFormCondNum = 1 To DestCell.FormatConditions.Count
> > > .FormatConditions(intFormCondNum) = _
> > > DestCell.FormatConditions(intFormCondNum)
> > > Next
> > > End If
> > > '***********************************
> > >
> > > .Copy ' Copy formatted contents of SourceCell to the
> > Clipboard
> > >
> > > ' Paste formatted contents of Clipboard to the DestCell
> > > DestCell.PasteSpecial (xlPasteAllExceptBorders)
> > >
> > > .Worksheet.Protect ' Protect the Source Cell worksheet
> > > DestCell.Worksheet.Protect ' Protect the Destination Cell
worksheet
> > >
> > > End With ' SourceCell
> > >
> > > As background, it may help to know that I'm copying source cells that
have
> > > rich text formatting, that I don't want to lose. Most of the
formatting
> > of
> > > the end result should come from teh destination cell, but the text
> > formatting
> > > needs to come from the source. I've only just noticed that I've been
> > > overwriting the destinations conditional formatting.
> >
> >
> >