Excel VBA loop through range to find Type of FormatCondition

Question

My issue:

I want to loop through a range, and whenever it finds a coloured cell, it should copy the cell to the left to the cell to the right of it. And then afterwards paste it into an other worksheet.

My sheet called “Compare” compares two sets of data, whereas a FormatConditions is applied as xlUniqueValues... The two sets of data, should contain the same data, but sometimes, there will be some, which are not within the other range. It is these cells that I am interested in finding with my loop, and then doping the processes if the criteria is met.

My code doesn't loop through the cells and returns me this message:

Run-time error '438': Object doesn't support this property or method

A screenshot of some of the data in Sheet "Compare":

My Code:

    Sub LoopForCondFormatCells()

    Dim sht3, sht4 As Worksheet
    Dim ColB, c As Range
    Set sht3 = Sheets("Compare")
    Set sht4 = Sheets("Print ready")

    ColB1 = sht3.Range("G3:G86")
    Set ColB = Range(ColB1)

   For Each c In ColB.Cells
   If c.FormatConditions.Type = xlUniqueValues Then 'Error here!
        CValue = c.Address(False, False, xlA1)
        CValueOffsetL = sht3.Range(CValue).Offset(0, -1).Address(False, False, xlA1)
        CValueOffsetR = sht3.Range(CValue).Offset(0, 1).Address(False, False, xlA1)
        sht3.Range(CValueOffsetL, CValueOffsetR).Copy
        KvikOffIns = sht4.Range(HosKvikOff).Offset(0, -1).Address(False, False, xlA1)
        sht4.Range(KvikOffIns).PasteSpecial xlPasteAll
        End If
    Next c

Goal:

I want the macro to loop through the cells, and find whatever cells, which has the FormatConditions type "xlUniqueValues". Whenever it comes across a cell, which is FormatConditions type "xlUniqueValues", it should do the steps:

CValue = c.Address(False, False, xlA1)
CValueOffsetL = sht3.Range(CValue).Offset(0, -1).Address(False, False, xlA1)
CValueOffsetR = sht3.Range(CValue).Offset(0, 1).Address(False, False, xlA1)
sht3.Range(CValueOffsetL, CValueOffsetR).Copy
KvikOffIns = sht4.Range(HosKvikOff).Offset(0, -1).Address(False, False, xlA1)
sht4.Range(KvikOffIns).PasteSpecial xlPasteAll

What should I write in my "If c Is" line to get the macro to do what I want it to do?

You say "My code loops through the cells easily". Frankly, I don't believe you. ColB1 = sht3.Range("G3:G86") returns an Array (default Values property of range). then Set ColB = Range(ColB1) where ColB1 is an array, throughs an error: 1004 — chris neilsen
That said, I'm not clear on what range you want to loop. Can you specify the desired range please? — chris neilsen
Sorry that was wrong... I edited it to the right thing... But the range is actually not a problem... — Patrick S
I'll get to the copy part once we sort the range loop,... because it is a problem (among others) — chris neilsen
Actually the desired range is set by variables for sht3... At the time of writing it is just "G3:G86", which it returns, so my laziness kicked in, and I didn't want to post to many things. My problem is that I don't know how to get VBA to look for the type? — Patrick S

chris neilsen chris neilsen · Accepted Answer · 2018-01-07T00:32:49

There a a number of issues in your code

Declare all variables. (Include Option Explicit at top of module to force this
Be specific on all declarations (Dim sht3, sht4 As Worksheet declares sht3 as Variant)
Your method of referencing ranges is convoluted and confusing and unnecassary
c.FormatConditions is a Collection of conditional formats, and doesn't have a Type. Iterate the collection and test the Type of each
You are copying everything, including the conditional formats. Is that your intent? If not, I'll update answer to show a different way

refactored code so far

Option Explicit

Sub LoopForCondFormatCells()

    Dim sht3 As Worksheet, sht4 As Worksheet
    Dim ColB As Range, c As Range
    Dim ColB1 As Range

    Dim HosKvikOff As Range
    Dim n As Long

    Set sht3 = Worksheets("Compare")
    Set sht4 = Worksheets("Print ready")

    Set HosKvikOff = sht4.Range("A1")  ' <-- update to suit

    Set ColB1 = sht3.Range("G3:G86")

    For Each c In ColB1.Cells
        With c.FormatConditions
            For n = 1 To .Count
                If .Item(n).Type = xlUniqueValues Then
                    c.Offset(0, -1).Resize(1, 3).Copy
                    HosKvikOff.PasteSpecial xlPasteAll
                    Set HosKvikOff = HosKvikOff.Offset(1, 0)  ' Increment output row
                End If
            Next

        End With
    Next
End Sub

A method not relying of Conditional Formatting

Option Explicit

Sub LoopForCondFormatCells()
    Dim sht3 As Worksheet, sht4 As Worksheet
    Dim ColB As Range, c As Range
    Dim ColB1 As Range

    Dim HosKvikOff As Range
    Dim n As Long

    Set sht3 = Worksheets("Compare")
    Set sht4 = Worksheets("Print ready")

    Set HosKvikOff = sht4.Range("A1")

    Set ColB1 = sht3.Range("G3:G86")

    ' Copy Non-duplicates
    For Each c In ColB1.Cells
        If Not IsEmpty(c) Then
            n = Application.WorksheetFunction.CountIfs(ColB1, c)
            If n = 1 Then
                c.Offset(0, -1).Resize(1, 3).Copy
                HosKvikOff.PasteSpecial xlPasteAll
                Set HosKvikOff = HosKvikOff.Offset(1, 0)
            End If
        End If
    Next

End Sub

Excel VBA loop through range to find Type of FormatCondition

1 Answers