Split cell data

Sharid · May 7, 2018

When I get my web data, it is as shown in the table below for the first three column A,B,C,.


 [TABLE="class: MsoNormalTable, width: 402"]
<tbody>[TR]
[TD="width: 91"]

[FONT=&quot]A[/FONT]

[/TD]
[TD="width: 190"]

[FONT=&quot]B[/FONT]

[/TD]
[TD="width: 255"]

[FONT=&quot]C[/FONT]

[/TD]
[/TR]
[TR]
[TD="width: 91"]

[FONT=&quot]UserID[/FONT]

[/TD]
[TD="width: 190"]

[FONT=&quot]submit_time[/FONT]

[/TD]
[TD="width: 255"]

[FONT=&quot]UserEmail[/FONT]

[/TD]
[/TR]
[TR]
[TD="width: 91"]

[FONT=&quot]1[/FONT]

[/TD]
[TD="width: 190"] [FONT=&quot]2018-05-01 13:59:39[/FONT]
[/TD]
[TD="width: 255"] [FONT=&quot]Youremail@gmail.com[/FONT]
[/TD]
[/TR]
[TR]
[TD="width: 91"]

[FONT=&quot]6[/FONT]

[/TD]
[TD="width: 190"] [FONT=&quot]2018-05-01 13:57:54[/FONT]
[/TD]
[TD="width: 255"] [FONT=&quot]Myemail@gmail.com[/FONT]
[/TD]
[/TR]
[TR]
[TD="width: 91"]

[FONT=&quot]33[/FONT]

[/TD]
[TD="width: 190"] [FONT=&quot]2018-05-01 13:55:12[/FONT]
[/TD]
[TD="width: 255"] [FONT=&quot]Gmail@gmail.com[/FONT]
[/TD]
[/TR]
[TR]
[TD="width: 91"]

[FONT=&quot]2[/FONT]

[/TD]
[TD="width: 190"] [FONT=&quot]2018-04-24 13:33:46[/FONT]
[/TD]
[TD="width: 255"] [FONT=&quot]webmail@gmail.com[/FONT]
[/TD]
[/TR]
[TR]
[TD="width: 91"]

[FONT=&quot]16[/FONT]

[/TD]
[TD="width: 190"] [FONT=&quot]2018-04-24 12:31:45[/FONT]
[/TD]
[TD="width: 255"] [FONT=&quot]Demo@gmail.com[/FONT]
[/TD]
[/TR]
</tbody>[/TABLE]

I copy and paste this data into my worksheet that has my VBA codes, so it will look the same as the table above.

I need a VBA code that will create a NEW column C and put the time into that when I click the command button, as shown below

[TABLE="class: MsoNormalTable, width: 403"]
<tbody>[TR]
[TD="width: 89"]

[FONT=&quot]A[/FONT]

[/TD]
[TD="width: 104"]

[FONT=&quot]B[/FONT]

[/TD]
[TD="width: 101"]

[FONT=&quot]C[/FONT]

[/TD]
[TD="width: 244"]

[FONT=&quot]D[/FONT]

[/TD]
[/TR]
[TR]
[TD="width: 89"]

[FONT=&quot]UserID[/FONT]

[/TD]
[TD="width: 104"]

[FONT=&quot]submit_time[/FONT]

[/TD]
[TD="width: 101"]

[FONT=&quot]submit_time[/FONT]

[/TD]
[TD="width: 244"]

[FONT=&quot]UserEmail[/FONT]

[/TD]
[/TR]
[TR]
[TD="width: 89"]

[FONT=&quot]1[/FONT]

[/TD]
[TD="width: 104"] [FONT=&quot]2018-05-01 [/FONT]
[/TD]
[TD="width: 101"]

[FONT=&quot]13:59:39[/FONT]

[/TD]
[TD="width: 244"] [FONT=&quot]Youremail@gmail.com[/FONT]
[/TD]
[/TR]
[TR]
[TD="width: 89"]

[FONT=&quot]6[/FONT]

[/TD]
[TD="width: 104"] [FONT=&quot]2018-05-01 [/FONT]
[/TD]
[TD="width: 101"]

[FONT=&quot]13:57:54[/FONT]

[/TD]
[TD="width: 244"] [FONT=&quot]Myemail@gmail.com[/FONT]
[/TD]
[/TR]
[TR]
[TD="width: 89"]

[FONT=&quot]33[/FONT]

[/TD]
[TD="width: 104"] [FONT=&quot]2018-05-01 [/FONT]
[/TD]
[TD="width: 101"]

[FONT=&quot]13:55:12[/FONT]

[/TD]
[TD="width: 244"] [FONT=&quot]Gmail@gmail.com[/FONT]
[/TD]
[/TR]
[TR]
[TD="width: 89"]

[FONT=&quot]2[/FONT]

[/TD]
[TD="width: 104"] [FONT=&quot]2018-04-24 [/FONT]
[/TD]
[TD="width: 101"]

[FONT=&quot]13:33:46[/FONT]

[/TD]
[TD="width: 244"] [FONT=&quot]webmail@gmail.com[/FONT]
[/TD]
[/TR]
[TR]
[TD="width: 89"]

[FONT=&quot]16[/FONT]

[/TD]
[TD="width: 104"] [FONT=&quot]2018-04-24 [/FONT]
[/TD]
[TD="width: 101"]

[FONT=&quot]12:31:45[/FONT]

[/TD]
[TD="width: 244"] [FONT=&quot]Demo@gmail.com[/FONT]
[/TD]
[/TR]
</tbody>[/TABLE]

I will reset my other VBA codes to factor in this new column

Joe4 · May 7, 2018

Is column B actually coming across as a valid date/time value, or is it coming across as text?
One way to know for sure is to see what this formula brings back (assuming that your first entry is in cell B2):
=ISNUMBER(B2)

If it returns FALSE, it is a text entry. If TRUE, it is a valid date/time entry.

Knowing that fact will help us determine how we need to write the VBA code.

Sharid · May 7, 2018

It has come back as FALSE

Its was showing True on what I was working on, but when I got the web data and pasted it into the sheet, then used your formula it came back as FALSE

yky · May 7, 2018

This should get your going.

Code:

Sub split()

Dim i As Integer

ThisWorkbook.Sheets(1).Range("C1").EntireColumn.Insert
For i = 2 To 6 Step 1

Cells(i, 3) = Format(TimeValue(Cells(i, 2)), "hh:mm:ss")
Cells(i, 3).NumberFormat = "hh:mm:ss"
Cells(i, 2).NumberFormat = "yyyy-mm-dd"

Next i

End Sub

Sharid · May 7, 2018

Just tested your code, it still work, but does not create a new column C it just pastes the dates into C and over rights the the emails.

Is this because I said it was TRUE but turned out FALSE

Sorry, but I should have said that it has to do this for all the data in that column, not just the first 6 that was just an example

Joe4 · May 7, 2018

OK, here is code that will do that split on any number of rows, and doesn't use any loops, so should be fairly efficient.
I documented it so you can see what each step is doing:

Code:

Sub MySplit()

    Dim lr As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row

'   Insert two columns after column B and add headings
    Columns("C:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C1") = "submit_date"
    Range("D1") = "submit_time"
    
'   Insert formulas into columns B and C
    Range("C2:C" & lr).FormulaR1C1 = "=INT(RC[-1])"
    Range("D2:D" & lr).FormulaR1C1 = "=RC[-2]-INT(RC[-2])"
    
'   Format columns
    Columns("C:C").NumberFormat = "m/d/yyyy"
    Columns("D:D").NumberFormat = "h:mm:ss;@"
    
'   Change to hard-coded values
    Columns("C:D").Copy
    Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
'   Delete original column B
    Columns("B:B").Delete

    Application.ScreenUpdating = True

End Sub

Joe4 · May 7, 2018

My previous reply was based on your first statement that they were returning TRUE (so were valid date/times).
If they actually are returning FALSE, you can use this version (note that this will also return Text values for these two columns, we would need to change it if you want the values coming back to be actual date/time values).

Code:

Sub MySplit2()

    Dim lr As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row

'   Insert two columns after column B and add headings
    Columns("C:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C1") = "submit_date"
    Range("D1") = "submit_time"
    
'   Insert formulas into columns B and C
    Range("C2:C" & lr).FormulaR1C1 = "=LEFT(RC[-1],FIND("" "",RC[-1])-1)"
    Range("D2:D" & lr).FormulaR1C1 = "=MID(RC[-2],FIND("" "",RC[-2])+1,LEN(RC[-2]))"
    
'   Change to hard-coded values
    Columns("C:D").Copy
    Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
'   Delete original column B
    Columns("B:B").Delete

    Application.ScreenUpdating = True

End Sub

Joe4 · May 7, 2018

If you do have it originally as Text, and want it to be valid dates and times after the split, you can use this version:

Code:

Sub MySplit3()

    Dim lr As Long
    
    Application.ScreenUpdating = False
    
'   Find last row with data in column B
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    
'   Convert column B to Date/Time
    Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 3), TrailingMinusNumbers:=True

'   Insert two columns after column B and add headings
    Columns("C:D").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("C1") = "submit_date"
    Range("D1") = "submit_time"
    
'   Insert formulas into columns B and C
    Range("C2:C" & lr).FormulaR1C1 = "=INT(RC[-1])"
    Range("D2:D" & lr).FormulaR1C1 = "=RC[-2]-INT(RC[-2])"
    
'   Format columns
    Columns("C:C").NumberFormat = "m/d/yyyy"
    Columns("D:D").NumberFormat = "h:mm:ss;@"
    
'   Change to hard-coded values
    Columns("C:D").Copy
    Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
'   Delete original column B
    Columns("B:B").Delete

    Application.ScreenUpdating = True

End Sub

Sharid · May 7, 2018

You code is super, it has done the job, Sorry for the delayed reply my internet keeps crashing.

A big thanks for this

Joe4 · May 7, 2018

You are welcome!

Split cell data

Sharid

Well-known Member

Excel Facts

Joe4

MrExcel MVP, Junior Admin

Sharid

Well-known Member

yky

Well-known Member

Sharid

Well-known Member

Joe4

MrExcel MVP, Junior Admin

Joe4

MrExcel MVP, Junior Admin

Joe4

MrExcel MVP, Junior Admin

Sharid

Well-known Member

Joe4

MrExcel MVP, Junior Admin

Similar threads

Forum statistics

Share this page

Split cell data

Well-known Member

Excel Facts

MrExcel MVP, Junior Admin

Well-known Member

Well-known Member

Well-known Member

MrExcel MVP, Junior Admin

MrExcel MVP, Junior Admin

MrExcel MVP, Junior Admin

Well-known Member

MrExcel MVP, Junior Admin

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock