CODEWITHSUNDEEP
excelexcel-2007vba
GoldBishop
GoldBishop

Reputation: 2861

Copy and Paste Value - With Coloring

I am in the process of developing an Export macro on various worksheets in a workbook. That being said, i need to have the worksheets with the Export macro to export the values of a specified range (named range) and the color formats they hold from a conditional format.

One thing I do not need is to copy the conditional formats that created the coloring. I only want the resulting color of the various cells in the range.

I have done this, code below, but when i open the rollup file, all the cells in question have the conditional formats pattern associated with them, which results in a coloring problem.

ws.range("rngAreaMetricDetail").Copy   'Area Mgr Store Metrics
newws.range("V3").PasteSpecial xlPasteValues    'Paste Values
newws.range("V3").PasteSpecial xlPasteFormats  'Paste Coloring
newws.Names.Add "rngAreaMetricDetail", Selection   'Create Named-Range from Selection

Thanx in advance.

Upvotes: 0

Views: 13977

Answers (3)

Diogo
Diogo

Reputation: 132

Try this code... Old one i use sometimes. I had to do Few things to make it good for you.

Sub move()
Dim lrow As Long
Dim lrow2 As Long
Dim rng As Range

Sheets(3).Cells.Clear


With Sheets(1)
    lrow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range(.Cells(2, 1), .Cells(lrow, 9))
    rng.Copy Sheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End With

With Sheets(3)
    lrow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range(.Cells(2, 1), .Cells(lrow, 9))
    rng.Interior.Color = vbYellow
End With

With Sheets(2)
    lrow = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range(.Cells(2, 1), .Cells(lrow, 9))
    rng.Copy Sheets(3).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End With

With Sheets(3)
    lrow2 = .Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range(.Cells(lrow2 - (lrow - 2), 1), .Cells(lrow2, 9))
    rng.Interior.Color = vbRed
End With

End Sub

Upvotes: 0

mischab1
mischab1

Reputation: 1601

Excel doesn't have an easy way to convert a conditional format into the results of the conditional format. You have to do everything manually:

  • Check to see if the FormatCondition is being used on each cell.
  • Manually assign the formats from the FormatCondition. (Borders, Font, Interior, & NumberFormat)
  • If you have more than one FormatCondition, the latter formats override the earlier ones unless StopIfTrue is set.

If you have Microsoft Word installed you can copy your range to Word and back to Excel letting Word take care of converting the formats.

Sub CopyConditionalFormattingThruWord(sAddress As String)
   Dim appWord As Word.Application, doc As Word.Document
   Dim wbkTo As Workbook

   ' copy from original table
   ThisWorkbook.Activate
   ThisWorkbook.Names!rngAreaMetricDetail.RefersToRange.Copy

   ' paste into word application and recopy
   Set appWord = New Word.Application
   With appWord
      .Documents.Add DocumentType:=wdNewBlankDocument
'      .Visible = True
      .Selection.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
      .Selection.HomeKey Unit:=wdStory, Extend:=wdExtend
      DoEvents
      .Selection.Copy
   End With

   ' copy to new workbook
   Set wbkTo = Excel.Application.Workbooks.Add
   wbkTo.Worksheets(1).Range(sAddress).Select
   wbkTo.ActiveSheet.Paste
   DoEvents

   ' close Word
   appWord.Quit SaveChanges:=False

   MsgBox "Done."

End Sub

Note: This doesn't copy the formatting 100% correctly but for most things, it is probably good enough. In the below example, I have 3 conditional formats applied to rows 1-9 in the table on the left. The table on the right is the result of running CopyConditionalFormattingThruWord sAddress:="B3".

example of running the above code

Excel 2010: If you were using Excel 2010, and didn't want to use Word, you can skip the FormatCondition testing by using the range's new DisplayFormat member. From the help file:

Actions such as changing the conditional formatting or table style of a range can cause what is displayed in the current user interface to be inconsistent with the values in the corresponding properties of the Range object. Use the properties of the DisplayFormat object to return the values as they are displayed in the current user interface.

You still have to manually assign the values from its Borders, Font, Interior, & NumberFormat etc.

Upvotes: 2

Siddharth Rout
Siddharth Rout

Reputation: 149315

Is this what you are trying?

I am assuming that there is only one condition that you are checking. I have not done any error handling. Hope you will take care of that as well.

Option Explicit

Sub Sample()
    Dim ws As Worksheet, newws As Worksheet

    Set ws = Sheets("Sheet1")
    Set newws = Sheets("Sheet2")

    '~~> Area Mgr Store Metrics
    ws.Range("rngAreaMetricDetail").Copy

    newws.Activate

    '~~> Paste Values
    Range("V3").PasteSpecial xlPasteValues

    Selection.Interior.ColorIndex = GetColor(Range("rngAreaMetricDetail"))
End Sub

Public Function GetColor(rng As Range)
    Dim oFC As FormatCondition

    Set rng = rng(1, 1)
    If rng.FormatConditions.Count > 0 Then
        For Each oFC In rng.FormatConditions
            GetColor = oFC.Interior.ColorIndex
            Exit For
        Next oFC
    End If
End Function

Upvotes: 0

Related Questions