In the attached is a macro
blah, which can be run by clicking the button on sheet
Before. It asks for the source range to process which initially defaults to an area beginning at row 4 (because I doubt you'll want to process row 3). If you don't cancel at this stage then it'll then ask for a destination range, which I've initially defaulted to A24 of the
After sheet. Again, if you don't cancel it'll process what you've asked it to and put the results at the destination.
For those interested this is the code:
Code:
Sub blah()
Dim Rng As Range, Destn As Range
Static SourceRngAddress As String
Static DestnAddress As String
If SourceRngAddress = "" Then SourceRngAddress = "A4:F11"
On Error Resume Next
Set Rng = Application.InputBox("Select range to process…", "Select range", SourceRngAddress, Type:=8)
On Error GoTo 0
If Not Rng Is Nothing Then
SourceRngAddress = Rng.Address(External:=True)
If DestnAddress = "" Then DestnAddress = "After!$A$24"
On Error Resume Next
Set Destn = Application.InputBox("Select destination…", "Select range", DestnAddress, Type:=8)
On Error GoTo 0
If Not Destn Is Nothing Then
DestnAddress = Destn.Address(External:=True)
x = Rng
ReDim RowsNeeded(1 To UBound(x))
For rw = 1 To UBound(x)
MaxLinesCount = -9
For Colm = 1 To UBound(x, 2)
y = Split(x(rw, Colm), vbLf)
LinesCount = UBound(y)
MaxLinesCount = Application.Max(MaxLinesCount, LinesCount)
Next Colm
' Rng.Rows(rw).Select
' MsgBox rw & " has " & MaxLinesCount + 1 & " lines"
RowsNeeded(rw) = MaxLinesCount + 1
Next rw
xx = Application.Sum(RowsNeeded)
ReDim Results(1 To xx, 1 To UBound(x, 2))
DestnRow1 = 1
For rw = 1 To UBound(x)
For Colm = 1 To UBound(x, 2)
DestnRow = DestnRow1
y = Split(x(rw, Colm), vbLf)
For i = LBound(y) To UBound(y)
Results(DestnRow, Colm) = y(i)
DestnRow = DestnRow + 1
Next i
Next Colm
DestnRow1 = DestnRow1 + RowsNeeded(rw)
Next rw
Destn.Resize(UBound(Results), UBound(Results, 2)).Value = Results
Application.Goto Destn
End If
End If
End Sub