Excel VBA - Find merged cells in column and add a formula

[MHamid]

Hello,

I am trying to figure out why this code is not working.
I need to find merged cells in column AX. Once these merged cells arefound I need to use the following vba formula to copy the value. What am Idoing wrong?

'Select Merged cells in column AX and add header based on EntityOwnership (column BC)
    If Worksheets("OTRC MORFile").Range("AX:AX").MergeCells Then
        Selection.FormulaR1C1 ="=R[1]C[5]"
    End If
    Columns("AX:AX").Select
    Application.CutCopyMode =False
    Selection.Copy
    Selection.PasteSpecialPaste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode =False

This is the code I would get when I use the record macro function, butthe range varies and that is why I can’t use the specific text below.

Sub FindMerged()
 
' FindMerged Macro
   Columns("AX:AX").Select
    Application.FindFormat.Clear
   Application.FindFormat.MergeCells = True
    WithApplication.FindFormat.Font
        .Subscript = False
        .TintAndShade = 0
    End With
    WithApplication.FindFormat.Interior
        .PatternColorIndex =xlAutomatic
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
   Range("AX5:BB5,AX9,AX13").Select
    Selection.FormulaR1C1 ="=R[1]C[5]"
   Range("AX9:BB9").Select
End Sub

Thank you

 

[JoeMo]

Untested, but this should find the merged cells in col AX put your formula in them and convert them to values.

Sub FindMerged()
Dim R As Range, Adr As String
With Application
    .FindFormat.Clear
    .ReplaceFormat.Clear
    .FindFormat.MergeCells = True
End With
Set R = Range("AX:AX").Find("", searchformat:=True)
If Not R Is Nothing Then
    Adr = R.Address
    Do
        R.FormulaR1C1 = "=R[1]C[5]"
        R.Value = R.Value
        Set R = Range("AX:AX").Find("", R, searchformat:=True)
        If R Is Nothing Then Exit Do
        If R.Address = Adr Then Exit Do
        R.FormulaR1C1 = "=R[1]C[5]"
        R.Value = R.Value
    Loop
Else
    MsgBox "no merged cells in col AX"
    Exit Sub
End If
With Application
    .FindFormat.Clear
    .ReplaceFormat.Clear
End With
End Sub

 

[MHamid]

Works great!

Thank you

 

[JoeMo]

Works great!

Thank you

You are welcome - thanks for the reply.

 

[MHamid]

I need to manipulate this code to find merged cells with the number 0 so I can clear that range.

How can I do that?

 

[JoeMo]

I need to manipulate this code to find merged cells with the number 0 so I can clear that range.

How can I do that?

You mean after the formulas are inserted and turned to values, if the value = 0 then clear the cells contents?

 

[MHamid]

yes

 

[MHamid]

Hello,

I just figured it out.

Finalized coding to remove merged cells with 0 value. I unmerged thecells within the first code you provided and then I added another codeafterwards that would find that value and clear the content within the rangethat was merged.

If you see a simpler way than what I have, feel free to let me know.

'Select Merged cells in column AX and add header based on EntityOwnership (column BC)
    Dim R As Range, Adr As String
    With Application
        .FindFormat.Clear
        .ReplaceFormat.Clear
        .FindFormat.MergeCells =True
    End With
    Set R =Range("AX:AX").Find("", SearchFormat:=True)
    If Not R Is Nothing Then
        Adr = R.Address
        Do
            R.FormulaR1C1 ="=R[1]C[5]"
            R.Value = R.Value
            Set R =Range("AX:AX").Find("", R, SearchFormat:=True)
            If R Is Nothing ThenExit Do
            If R.Address = AdrThen Exit Do
            R.FormulaR1C1 ="=R[1]C[5]"
            R.Value = R.Value
            If R.Value = 0 Then
                R.UnMerge
            End If
        Loop
    Else
        MsgBox "no mergedcells in col AX"
        Exit Sub
    End If
    With Application
        .FindFormat.Clear
        .ReplaceFormat.Clear
    End With
 
'Find 0 value in column AX and clear cell with adjacent cells
    Dim r1 As Long
    Dim LastR As Long
    LastR = Range("B"& Rows.Count).End(xlUp).Row
    For r1 = 1 To LastR
        If Cells(r1,"AX") = 0 Then
            Range(Cells(r1,"AX"), Cells(r1, "BB")).Clear
        End If
    Next r1

Thank you for your assistance