search and find location of colorindex = 16

[abenitez77]

I have several locations in my spreadsheet that have merged cell location that has the colorindex of 16. I want to save the address of the different locations in my sheet that have colorindex of 16 to several variables or an array.. How can i do this?

thanks

 

[JoeMo]

Try this. Adr16 is the array you want. Here its printed to the Immediate Window, but you can replace that line with code to do whatever you want with the array.

Sub Sweet16()
Dim V As Variant, Adr16 As Variant, i As Long
With ActiveSheet.UsedRange
    V = .Cells.Value
    With Application
        .FindFormat.Clear
        .ReplaceFormat.Clear
        .FindFormat.Interior.ColorIndex = 16
    End With
    .Replace "*", "#N/A", SearchFormat:=True, ReplaceFormat:=False
    On Error Resume Next
    Adr16 = Split(.SpecialCells(xlCellTypeConstants, xlErrors).Address(0, 0), ",")
    For i = LBound(Adr16) To UBound(Adr16)
        Debug.Print Adr16(i)
    Next i
    .Cells.Value = V
End With
With Application
    .FindFormat.Clear
    .ReplaceFormat.Clear
End With
End Sub

 

[abenitez77]

Try this. Adr16 is the array you want. Here its printed to the Immediate Window, but you can replace that line with code to do whatever you want with the array.

Sub Sweet16()
Dim V As Variant, Adr16 As Variant, i As Long
With ActiveSheet.UsedRange
    V = .Cells.Value
    With Application
        .FindFormat.Clear
        .ReplaceFormat.Clear
        .FindFormat.Interior.ColorIndex = 16
    End With
    .Replace "*", "#N/A", SearchFormat:=True, ReplaceFormat:=False
    On Error Resume Next
    Adr16 = Split(.SpecialCells(xlCellTypeConstants, xlErrors).Address(0, 0), ",")
    For i = LBound(Adr16) To UBound(Adr16)
        Debug.Print Adr16(i)
    Next i
    .Cells.Value = V
End With
With Application
    .FindFormat.Clear
    .ReplaceFormat.Clear
End With
End Sub

This worked, thanks! I have another thing I needed help with. The first section that it found was the range (L12:Y12). Within that section, there are 2 merged sections (first one is L12:R12, second one is S12:Y12). How do I get the 2 merged locations after finding the color location of L12:Y12 ?

 

[JoeMo]

You are welcome. The modification below - modified the code already pasted and added a procedure for identifying merged ranges - will address your added request. The array ma contains the merged areas.

Sub Sweet16()
Dim V As Variant, Adr16 As Variant, i As Long
With ActiveSheet.UsedRange
    V = .Cells.Value
    With Application
        .FindFormat.Clear
        .ReplaceFormat.Clear
        .FindFormat.Interior.ColorIndex = 16
    End With
    .Replace "*", "#N/A", SearchFormat:=True, ReplaceFormat:=False
    On Error Resume Next
    Adr16 = Split(.SpecialCells(xlCellTypeConstants, xlErrors).Address(0, 0), ",")
    Debug.Print "Ranges with colorindex 16"
    For i = LBound(Adr16) To UBound(Adr16)
        Debug.Print Adr16(i)
    Next i
    .Cells.Value = V
End With
With Application
    .FindFormat.Clear
    .ReplaceFormat.Clear
End With
Call FindMergedCells
End Sub
Sub FindMergedCells()
Dim c As Range, Rws As Long, Cols As Long, mA() As String, ct As Long
Application.DisplayAlerts = False
For Each c In ActiveSheet.UsedRange
    If c.MergeCells Then
        ct = ct + 1
        Rws = c.MergeArea.Rows.Count
        Cols = c.MergeArea.Columns.Count
        ReDim Preserve mA(1 To ct)
        mA(ct) = c.Resize(Rws, Cols).Address(0, 0)
        c.UnMerge
    End If
Next c
If ct > 0 Then
    Debug.Print "Merged Ranges"
    For i = LBound(mA) To UBound(mA)
        Debug.Print mA(i)
        Range(mA(i)).Merge
    Next i
End If
End Sub

 

[abenitez77]

JoeMo, the code works but it shows me all the merged cells found in the sheet. I only want to know the address of the merged cells for the colors found. Also, I noticed that when the color is found, it replaces the value in that merged cell for "#N/A". I need the value in that cell to save it in a variable for later.

thanks

 

[JoeMo]

The #N/A is temporary unless you have failed to let the code run all the way through. This line:

.Cells.Value = V

restores the original data.

If you just want merged cells that have a colorindex 16 fill, then use this modification:

Sub Sweet16()
Dim V As Variant, Adr16 As Variant, i As Long
With ActiveSheet.UsedRange
    V = .Cells.Value
    With Application
        .FindFormat.Clear
        .ReplaceFormat.Clear
        .FindFormat.Interior.ColorIndex = 16
    End With
    .Replace "*", "#N/A", SearchFormat:=True, ReplaceFormat:=False
    On Error Resume Next
    Adr16 = Split(.SpecialCells(xlCellTypeConstants, xlErrors).Address(0, 0), ",")
    Debug.Print "Ranges with colorindex 16"
    For i = LBound(Adr16) To UBound(Adr16)
        Debug.Print Adr16(i)
    Next i
    .Cells.Value = V
End With
With Application
    .FindFormat.Clear
    .ReplaceFormat.Clear
End With
Call FindMergedCells
End Sub
Sub FindMergedCells()
Dim c As Range, Rws As Long, Cols As Long, mA() As String, ct As Long
Application.DisplayAlerts = False
For Each c In ActiveSheet.UsedRange
    If c.MergeCells And c.Interior.ColorIndex = 16 Then
        ct = ct + 1
        Rws = c.MergeArea.Rows.Count
        Cols = c.MergeArea.Columns.Count
        ReDim Preserve mA(1 To ct)
        mA(ct) = c.Resize(Rws, Cols).Address(0, 0)
        c.UnMerge
    End If
Next c
If ct > 0 Then
    Debug.Print "Merged Ranges"
    For i = LBound(mA) To UBound(mA)
        Debug.Print mA(i)
        Range(mA(i)).Merge
    Next i
End If
End Sub

 

[abenitez77]

Sorry, you are correct, as I stepped thru to the end it did restore the original data.

Thanks again for your help, this worked perfectly for what I needed.

 

[JoeMo]

Sorry, you are correct, as I stepped thru to the end it did restore the original data.

Thanks again for your help, this worked perfectly for what I needed.

You are welcome - thanks for the reply.