Split Me, Shape Me

in which we publish something we wrote a while back but forgot to post for reasons now lost in the mists of time

While I’d love to be able to take credit for having thought of this myself, the truth is I can’t. I did clean up the code a fair bit, though, so any tidiness that particularly appeals is entirely down to me.

Reading this post a while back, I leapt to post my CellSplit() function in the comments, then realised that I typically use it in conjunction with a rather more substantial macro, one that wasn’t going to sit well in someone else’s blog comments.

Here’s my CellSplit(), which is just a wrapper for the VBA Split() function:

Public Function CellSplit(celValue As String, delim As String) As Variant
    CellSplit = Split(celValue, delim)
End Function

On its own, it’s moderately useful, but unless you know how many parts your input string will split into, you’re going to be fooling about with range resizing. In these dark days there’s no time for fooling about – we need a tool to get that resizing down for us in One Click.

Enter a toolbar (sorry, RibbonX) button, assigned to the Range Resize Wizard…

Public Sub RangeResizeWizard()

Dim result As Variant
Dim fmla As String
Dim rng As range
Dim targetRows As Long
Dim targetCols As Long

On Error GoTo Catch

Set rng = Selection
If IsEmpty(rng) Then Exit Sub

If rng.HasArray Then
  Set rng = rng.CurrentArray
  fmla = rng.FormulaArray
ElseIf rng.rows.Count = 1 And rng.Columns.Count = 1 Then
  fmla = rng.Formula
Else
  Exit Sub
End If

result = Evaluate(fmla)

With rng
  .ClearContents
  If IsArray(result) Then
    If NumberOfDimensions(result) = 2 Then
      targetRows = UBound(result, 1) - LBound(result, 1) + 1
      targetCols = UBound(result, 2) - LBound(result, 2) + 1
    Else
      targetRows = 1
      targetCols = UBound(result, 1) - LBound(result, 1) + 1
    End If
    On Error GoTo RestoreFormula:
    .Resize(targetRows, targetCols).FormulaArray = fmla
    On Error GoTo Catch
  Else
    .Formula = fmla
  End If
End With

Finally:
  On Error GoTo 0
  Exit Sub

Catch:
  Debug.Print Err.Description
  Resume Finally

RestoreFormula:
  Debug.Print Err.Description
  rng.FormulaArray = fmla
  Resume Finally
End Sub

Function NumberOfDimensions(arr As Variant)

Dim dimensions As Long
Dim junk As Long

On Error GoTo FinalDimension

For dimensions = 1 To 60000
  junk = LBound(arr, dimensions)
Next
Exit Function

FinalDimension:
  NumberOfDimensions = dimensions - 1
End Function

Note that the array formula in question will be re-evaluated twice, once to determine the dimensions of the output array and again when the formula is pushed back into the new, perfectly-sized range. Further, the routine assumes you haven’t left anything important lying around where it can get overwritten. So it’s to be used with care, but if you spend much time with array formula, you’ll probably find it as useful as I do (if you haven’t already written it yourself).

Note further that it’s not really a “wizard” in the programming sense, in that it doesn’t do any of that walking-you-through-steps thing. It’s just a bit magic.

Advertisement