StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
text
Body
copied!<p>Here is an example from another solution <a href="https://superuser.com/q/486294/160170">How to split cell in a row with Excel</a>, which I modified just a tiny bit to fit your situation:</p> <pre><code>Public Sub solutionJook() Dim arr() As Variant Dim arrSum() As Variant Dim arrResult() As Variant Dim arrTemp As Variant Dim i As Long Dim j As Long Dim h As Long Dim lngSplitColumn As Long 'input of array to seperate -> should cover all columns+rows of your data arr = Range("A1:C2") 'specify which column has the values to be split up -> here this is the category column lngSplitColumn = 2 'using the boundries of the given range, 'arrSum has now always the right boundries for the first dimension ReDim Preserve arrSum(LBound(arr, 2) To UBound(arr, 2), 1 To 1) 'create the array with seperated A B C For i = LBound(arr, 1) To UBound(arr, 1) 'use split to make Foods/Dog/Treats Pre-Pack into an array, using '\' (chr(92)) as indicator arrTemp = Split(arr(i, lngSplitColumn), Chr(92)) 'every value of arrTemp creates a new row For j = LBound(arrTemp) To UBound(arrTemp) 'loop through all input columns and create the new row For h = LBound(arr, 2) To UBound(arr, 2) If h = lngSplitColumn Then 'setup the value of the splitted column Dim k as long arrSum(h, UBound(arrSum, 2)) = arrTemp(LBound(arrTemp)) for k = LBound(arrTemp)+1 to j arrSum(h, UBound(arrSum, 2)) = arrSum(h, UBound(arrSum, 2)) & "\" & arrTemp(k) 'set Foods Foods/Dog Foods/Dog/Treats Pre-Pack next k Else 'setup the value of any other column arrSum(h, UBound(arrSum, 2)) = arr(i, h) 'set Value of Column h End If Next h ReDim Preserve arrSum(LBound(arr, 1) To UBound(arr, 2), _ LBound(arrSum, 2) To (UBound(arrSum, 2) + 1)) Next j Next i 'clean up last empty row (not realy necessary) ReDim Preserve arrSum(LBound(arr, 1) To UBound(arr, 2), _ LBound(arrSum, 2) To (UBound(arrSum, 2) - 1)) 'setup transposed result array ReDim arrResult(LBound(arrSum, 2) To UBound(arrSum, 2), _ LBound(arrSum, 1) To UBound(arrSum, 1)) 'transpose the array For i = LBound(arrResult, 1) To UBound(arrResult, 1) For j = LBound(arrResult, 2) To UBound(arrResult, 2) arrResult(i, j) = arrSum(j, i) Next j Next i 'specify target range Range(Cells(1, 5), Cells(UBound(arrResult, 1), 4 + UBound(arrResult, 2))) = arrResult End Sub </code></pre> <p>You might need to adapt the target range however.</p> <p><code>Cells(1,5)</code> -> E1 is the starting point of pasting</p>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload