Split Me, Shape Me
4 October 2011 1 Comment
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.