View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Peter T Peter T is offline
external usenet poster
 
Posts: 5,600
Default Copy current color of conditional formatted cell

If I follow your first question, you want to copy values & formats (excl
CF's) between sheets, and where any CF formats have kicked in copy the
resulting format too.

This requires evaluating the True/false state of all the CF cells and the
format applied if True for each cell. This might be very simple if you know
both the condition to evaluate and the format to be applied as in the highly
contrived example below. Otherwise you need to read one or two of the CF
formulas with operators(s), together with format for up to 3 conditions.
This can get quite tricky to get all conceivable results particularly where
non relative cells are used in formulas (A1 vs $A$1).

Following assumes you know the all CF's on the source sheet are like this

Cell Value Is : equal to : ="abc"
Format... : Patterns : pink colorindex 38

Sub test()
Dim cnt As Long, i As Long
Dim rng As Range
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Set wsSource = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")

wsSource.Cells.Copy
wsDest.Cells.PasteSpecial xlValues
wsDest.Cells.PasteSpecial xlFormats

On Error Resume Next
Set rng = wsSource.Cells(1,
1).SpecialCells(xlCellTypeAllFormatConditions)
On Error GoTo 0

If Not rng Is Nothing Then
wsDest.Cells.FormatConditions.Delete
ReDim arrCFs(1 To rng.Count) As String

For Each cell In rng
If cell.Value = "abc" Then
cnt = cnt + 1
arrCFs(cnt) = cell.Address
End If
Next

With wsDest
For i = 1 To cnt
.Range(arrCFs(i)).Interior.ColorIndex = 38
Next
End With

End If
wsDest.Activate
Range("A1").Select

End Sub

I can't imagine ever using code as written above, it's only an illustration.

Your second question -
I adapted the following code from Peter T to my sub, but the pictures all
pasted starting in cell A1 for some reason.


The routine appears to have been copied exactly from another post and not
"adapted", at least as far as I can see. Have you changed something in your
own project perhaps. If not, I don't know why your pictures are pasted to
cell A1, try and recreate manually what the code attempts to do -

- Select the objects you want to copy (in your case all pictures)
- Visually note the topmost row of any selected object and the left most
column of any selected object, scroll right & down if necessary, say B4 is
the top left intersect
- Right click selected objects and Copy
- Activate the destination sheet
- Select cell B4 as the potential topleft cell of all objects
- Paste

Does this paste objects into correct relative positions, if so I'm not sure
why the macro doesn't work same.

Regards,
Peter T


"justme" wrote in message
...
Hi y'all,

I have a button on sheet "Master" that calls a sub to copy the contents of
sheet "Master" to sheet "FitterSurvey"--values and formatting only.

Public Sub FS_CreateFitterSurvey()
'
' Copies data from Master sheet to Fitter Survey sheet
'
On Error GoTo ErrorHandler

Dim Master As Worksheet
Dim FitterSurvey As Worksheet

Set Master = ActiveWorkbook.Sheets("Master")
Set FitterSurvey = ActiveWorkbook.Sheets("FitterSurvey_XXXXX")

Master.Activate
With Master
Cells.Select
Selection.Copy
End With

With FitterSurvey.Range("A1")
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With

Master.Activate
Range("A1").Select
FitterSurvey.Activate
Range("A1").Select

End Sub


I need help with two problems:

1) some of the cells on the origin sheet are conditionally formatted to

turn
pink based on value.

For example:
Cell B3 on sheet "Master"
Cell N3 on sheet "Person"

Cell B3's formula is:
=IF(ISBLANK('(Person)'!N3),"Please enter your title here",'(Person)'!N3)

Then, conditional formatting kicks in and based on a cell value of "Please
enter your title", it will turn B3 text color pink instead of automatic.

Then, after I use the sub above to copy the values and formats of the

whole
page to "FitterSurvey". B3 on FitterSurvey remains pink due to the copied
over conditional formatting.

However, what I would really like is for B3 on FitterSurvey, whether it is
pink or black, to remain pink (or automatic) from now on, no matter what

the
value (normal text color = pink or normal color = automatic).

Can this be solved either during the copy paste process, or after the

paste,
to convert the normal color of the cell text to whatever it currently is
under conditional formatting?


2) The "Master" sheet will contain pictures or drawing objects, but

they're
changing all the time. So, when I use the above macro to copy over the
contents, I would like for it to copy any objects over to the FitterSurvey
sheet, in the *exact same positions*. I have tried different things I've
seen in posts, but I can not get them to work correctly in my sub.

I adapted the following code from Peter T to my sub, but the pictures all
pasted starting in cell A1 for some reason. They were, however, correctly
positioned relative to each other.

Sub CopyAllPictures()
Dim r As Long, c As Long
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim pic As Picture

Set wsSource = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")

r = wsSource.Rows.Count
c = wsSource.Columns.Count

For Each pic In wsSource.Pictures
With pic.TopLeftCell
If .Row < r Then r = .Row
If .Column < c Then c = .Column
End With
Next

wsDest.Activate
wsDest.Cells(r, c).Activate

wsSource.Pictures.Copy
wsDest.Paste

wsDest.Cells(r, c).Activate

End Sub