Enable Your Employees To Focus On The Core With Intuitive Onscreen Guidance That is With You At The Moment of Need.
Become a Premium Member and unlock a new, free course in leading technologies each month.
Sub splitme()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = ActiveSheet
Dim r As Range
Dim V As Variant
Dim a() As String
Dim i As Integer
Dim row As Long
Dim endRow As Long
Set r = Intersect(ws.UsedRange, ws.Range("W:W"))
row = r.row
endRow = r.row - 1 + r.Rows.Count
While row <= endRow
Set r = ws.Range("W" & row)
a = Split(r.Value, ";")
If UBound(a) > 2 Then
r.Value = a(0) & ";" & a(1)
For i = 2 To UBound(a) Step 2
V = r.EntireRow
r.EntireRow.Insert
r.EntireRow.Offset(-1) = V
'Set r = r.Offset(1)
If UBound(a) >= i + 1 Then
r.Value = a(i) & ";" & a(i + 1)
Else
r.Value = a(i)
End If
Next i
End If
row = r.row + 1
Wend
Application.ScreenUpdating = True
End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Sub kTest()
Dim x, k(), ka, i As Long, n As Long, j As Long, c As Long
Const TotalCols As Long = 60
Const SplitCol As Long = 23 'W
ka = ActiveSheet.UsedRange.Resize(, TotalCols)
ReDim k(1 To UBound(ka, 1) * 15, 1 To TotalCols)
For i = 1 To UBound(ka, 1)
x = Split(ka(i, SplitCol), ";")
For j = 0 To UBound(x) Step 2
n = n + 1
For c = 1 To UBound(ka, 2)
If UBound(x) >= j + 1 Then
If c = SplitCol Then
k(n, c) = x(j) & ";" & x(j + 1)
Else
k(n, c) = ka(i, c)
End If
Else
If c <> SplitCol Then
k(n, c) = ka(i, c)
Else
k(n, c) = x(j)
End If
End If
Next
Next
Next
Range("a1").Resize(n, TotalCols).Value = k
End Sub
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Automate an Oracle update in Excel | 7 | 70 | |
Excel VBA inserting a formula | 12 | 39 | |
drag and drop (but keep all) lines | 11 | 46 | |
how to change this formula so that INDEX starts from C2 not C1 | 1 | 17 |
Join the community of 500,000 technology professionals and ask your questions.