CODEWITHSUNDEEP
excelvba
MonroeGA
MonroeGA

Reputation: 155

Get the value of the first cell that is centered across selection for the current cell?

I am told we should be using Centered Across Selection instead of Merged Cells. I need to get the underlying value that is displayed across the cells when formatted as Centered Across Selection.

When using Merged Cells:

CellValue = rng.MergeArea.Cells(1, 1).Value

Is there an easy way to get the same for Centered Across Selection, other than searching backwards while HorizontalAlignment = xlHAlignCenterAcrossSelection until the Cell Value <> ""? My code to do this would be:

Function GetCenteredAcrossSelectionCellValue(rng As Range) As Variant

    Dim i As Long
    Dim l As Long
    Dim ws As Worksheet
    
    Set ws = rng.Worksheet
    
    i = rng.Column
    r = rng.Row
    
    If rng.HorizontalAlignment = xlHAlignCenterAcrossSelection Then
        Do Until (ws.Cells(r, i).Value <> "" And rng.HorizontalAlignment = xlHAlignCenterAcrossSelection)
            i = i - 1
        Loop
    End If
    
    GetCenteredAcrossSelectionCellValue = ws.Cells(r, i).Value

End Function

I don't this this is foolproof, because it could be possible that someone applied Center Across Selection to a single cell (say A1 for example) with a value, and then applied Center Across Selection to three empty cells (B1:D1).
When asked for the "value" for D1, the above code would return the value in A1.

Excel must know because it formats correctly.

Upvotes: 1

Views: 245

Answers (1)

Tim Williams
Tim Williams

Reputation: 166491

Following on from the comment above...

Apply "center across selection" to A1:J1 then run tester with values in different cells in that range and compare the outputs.

Sub tester()
    Dim c As Range, rng As Range
    For Each c In Range("A1:J1")
        Set rng = CenteredRange(c)
        If Not rng Is Nothing Then
            Debug.Print c.Address, rng.Address
        Else
            Debug.Print c.Address, "not centered"
        End If
    Next c
End Sub

'return the current "center across" range given a starting point
Function CenteredRange(c As Range) As Range
    Dim cStart As Range, cEnd As Range, cNext As Range
    
    Set c = c.Cells(1) 'make sure we're dealing with a single cell
    If Not c.HorizontalAlignment = xlCenterAcrossSelection Then Exit Function
    
    Set cStart = c.Parent.Range(c.Address)
    Set cEnd = c.Parent.Range(c.Address)
    
    'look for the beginning
    Do While cStart.Column > 1 And cStart.HorizontalAlignment = xlCenterAcrossSelection
        If Len(cStart.Value) > 0 Then Exit Do 'stop if find a value
        Set cStart = cStart.Offset(0, -1)
    Loop
    'look for the end
    Do While cEnd.Column < Columns.Count - 1 And cEnd.HorizontalAlignment = xlCenterAcrossSelection
        Set cNext = cEnd.Offset(0, 1) 'checking the next cell...
        If Len(cNext.Value) > 0 Or cNext.HorizontalAlignment <> xlCenterAcrossSelection Then Exit Do
        Set cEnd = cEnd.Offset(0, 1)
    Loop
    Set CenteredRange = c.Parent.Range(cStart, cEnd)
End Function

Upvotes: 1

Related Questions