in VBA : Copy formatting without copying the rules from a Conditional Formatted cell

[netuser]

I want to copy some data that is conditional formatted, but i want to paste in another sheet with formatting but without rules.

Only way I found is to paste in word and copy it back, but as I have multiple table and I need to do it via VBA.

Is there any easy way ?

Thanks

 

[svendiamond]

Just copy it with VBA and then use this line:

Range("yourRangeHere").FormatConditions.Delete

So like if you want to copy A1:A10 to C1:C10 you could write:

Range("A1:A10").Copy Range("C1")
Range("C1:C10").FormatConditions.Delete

 

[netuser]

This delete the formatting. I want to keep formatting but remove conditional rules to the newly pasted range.

 

[svendiamond]

This only deletes formatting that is coming from Conditional Formatting rules. Are you saying you have a range that uses conditional formatting, and you want to copy it to another range, KEEP the formats, but delete the RULES?

 

[RoryA]

I think you'd need API calls. Something like this will paste the copied formatted data but without the rules:

Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EnumClipboardFormats Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardFormatName Lib "user32" Alias "GetClipboardFormatNameA" ( _
                                                ByVal wFormat As Long, ByVal lpString As String, _
                                                ByVal nMaxCount As Long) As Long

Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" ( _
                                 ByVal lpString As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" ( _
                                 ByVal lpStr1 As Any, ByVal lpStr2 As Any) As Long

Sub PasteAsLocalFormula()
'If the clipbaord contains an Excel range, any formula is pasted unchanged, moving sheet and _
  cell references to the destination workbook.
    Dim S                     As String
    Dim i As Long, CF_Format  As Long
    Dim SaveDisplayAlerts As Boolean, SaveScreenUpdating As Boolean
    Dim HTMLInClipBoard       As Boolean
    Dim Handle As Long, Ptr As Long, FileName As String

    'Enumerate the clipboard formats
    If OpenClipboard(0) Then
        CF_Format = EnumClipboardFormats(0&)
        Do While CF_Format <> 0
            S = String(255, vbNullChar)
            i = GetClipboardFormatName(CF_Format, S, 255)
            S = Left(S, i)
            HTMLInClipBoard = InStr(1, S, "HTML Format", vbTextCompare) > 0

            If HTMLInClipBoard Then
                Handle = GetClipboardData(CF_Format)
                Ptr = GlobalLock(Handle)
                Application.CutCopyMode = False
                S = Space$(lstrlen(ByVal Ptr))
                lstrcpy S, ByVal Ptr
                GlobalUnlock Ptr
                SetClipboardData CF_Format, Handle
                ActiveSheet.PasteSpecial Format:="HTML"
                Exit Do
            End If

            CF_Format = EnumClipboardFormats(CF_Format)
        Loop
        CloseClipboard
    End If

End Sub

 

[netuser]

Thanks Rorya that work great.

Now is there any easy way to use this during my Loops ? I loop thought different sheet to copy my data then go to Data sheet to paste it .

Anyway to make your code as Function so I can call it to paste or another easy way without putting 50 time the same for code.

Here is an extract of my code to show how I am currently pasting my data (Note I was using value to avoid copying Conditional formatting rules) :

ActiveSheet.Range("A" & foundS.Row + 1 & ":H" & foundEnd.Row - 1).Copy
                Sheets("Data").Range("A" & Rng).PasteSpecial Paste:=xlPasteValues

 

[Jaafar Tribak]

@ Rory
Neat workaround ... I had nevetr paid attention to the Worksheet.PasteSpecial Format argument

One thing I don't understand is the need to set the CutCopyMode Property of the application to False (or to any onther Long value for that matter) in order for the code to work !!

Also, I don't understand the need for copying the clipboard HTML content to a String buffer .. seems redundant to me unless I am missing something.

The folllowing simplification should work just as well :

    If OpenClipboard(0) Then
        CF_Format = EnumClipboardFormats(0&)
        Do While CF_Format <> 0
            S = String(255, vbNullChar)
            i = GetClipboardFormatName(CF_Format, S, 255)
            S = Left(S, i)
            HTMLInClipBoard = InStr(1, S, "HTML Format", vbTextCompare) > 0
            If HTMLInClipBoard Then
                Application.CutCopyMode = False
                ActiveSheet.PasteSpecial Format:="HTML"
                Exit Do
            End If
            CF_Format = EnumClipboardFormats(CF_Format)
        Loop
        CloseClipboard
    End If

Thanks for teaching us something new

 

[RoryA]

@Jaafar,

I confess I wrote this so long ago I can't remember why it is the way it is, but I suspect it was adapted quickly from something else (I think the routine name and the comment support this), which may explain the buffer.

I don't think I ever figured out why you had to turn copy mode off for the code to work properly.

 

[RoryA]

Thanks Rorya that work great.

Now is there any easy way to use this during my Loops ?

Change the routine to:

Sub PasteFormattedRange(rgFrom as Range, rgTo as range)

    Dim S                     As String
    Dim rgStart as Range
    Dim i As Long, CF_Format  As Long
    Dim SaveDisplayAlerts As Boolean, SaveScreenUpdating As Boolean
    Dim HTMLInClipBoard       As Boolean
    Dim Handle As Long, Ptr As Long, FileName As String
set rgStart = selection
rgFrom.Copy

    'Enumerate the clipboard formats
    If OpenClipboard(0) Then
        CF_Format = EnumClipboardFormats(0&)
        Do While CF_Format <> 0
            S = String(255, vbNullChar)
            i = GetClipboardFormatName(CF_Format, S, 255)
            S = Left(S, i)
            HTMLInClipBoard = InStr(1, S, "HTML Format", vbTextCompare) > 0
            If HTMLInClipBoard Then
                Application.CutCopyMode = False
                Application.Goto rgTo
                ActiveSheet.PasteSpecial Format:="HTML"
                application.goto rgStart
                Exit Do
            End If
            CF_Format = EnumClipboardFormats(CF_Format)
        Loop
        CloseClipboard
    End If

End Sub

and then your code would become:

PasteFormattedRange ActiveSheet.Range("A" & foundS.Row + 1 & ":H" & foundEnd.Row - 1), Sheets("Data").Range("A" & Rng)

 

[Jaafar Tribak]

@Jaafar,

I confess I wrote this so long ago I can't remember why it is the way it is, but I suspect it was adapted quickly from something else (I think the routine name and the comment support this), which may explain the buffer.

I don't think I ever figured out why you had to turn copy mode off for the code to work properly.

Thanks