CODEWITHSUNDEEP
vbaexcel
pdx
pdx

Reputation: 301

VBA - Split cell values and put it into the row below

I am looking for a code that would split the cells of the last row after ":" as shown below:

Before

enter image description here

After

enter image description here

So far splitting data looks like this - but it only works for the first cell:

Sub test()
Dim ws As Worksheet
Set ws = Sheets("Sheet3")
Dim fullstring As String, colonposition As Integer, j As Integer, LastRow As Long, FirstRow As Long
Dim lRow As Long, lCol As Long
lRow = Cells(Rows.Count, 1).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
    For j = 1 To 3
    fullstring = Cells(lRow, lCol).Value
    colonposition = InStr(fullstring, ":")
    Cells(lRow, j).Value = Left(fullstring, colonposition - 1)
    lRow = lRow + 1
    Cells(lRow, j).Value = Mid(fullstring, colonposition + 1)
    Next

End Sub

I have found a similar problematic (with answer) here but can't manage to apply it ONLY to the last row

Any suggestions appreciated!

Upvotes: 0

Views: 1052

Answers (2)

pdx
pdx

Reputation: 301

In case some people are interested in the answers to the discussion with @Ondrej, here are two codes, the first is static and the second is dynamic:

Sub test()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Dim actualRange As Range
For Each actualRange In ws.Range(ws.Cells(ws.Rows.Count, 1).End(xlUp), ws.Cells(ws.Rows.Count, 1).End(xlUp).End(xlToRight))
If InStr(Trim(actualRange), ":") > 0 Then
actualRange.Offset(1, 0).Value = Split(actualRange.Value, ":")(1)
actualRange.Offset(0, 0).Value = Split(actualRange.Value, ":")(0)

End If
Next
End Sub

&

Sub test()
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Dim actualRange As Range
Dim tmpString As String
For Each actualRange In ws.Range(ws.Cells(ws.Rows.Count, 1).End(xlUp), ws.Cells(ws.Rows.Count, 1).End(xlUp).End(xlToRight))
tmpString = actualRange.Value
If InStr(Trim(tmpString), ":") > 0 Then
actualRange.Offset(0, 0).Value = Split(tmpString, ":")(0)

actualRange.Offset(1, 0).Value = Split(tmpString, ":")(1)

End If
Next
End Sub

Upvotes: 0

holmicz
holmicz

Reputation: 577

I prefer using Range method with for each statement, like following:

Sub test()
    Dim ws As Worksheet
    Set ws = Sheets("Sheet3")
    Dim actualRange As Range
    For Each actualRange In ws.Range(ws.Cells(ws.Rows.Count, 1).End(xlUp), ws.Cells(ws.Rows.Count, 1).End(xlUp).End(xlToRight))
        actualRange.Offset(-1, 0).Value = Split(actualRange.Value, ":")(0)
        actualRange.Offset(0, 0).Value = Split(actualRange.Value, ":")(1)
    Next
End Sub

Upvotes: 1

Related Questions