Splitting date and time

H

honkin

Active Member
Joined
Mar 20, 2012
Messages
374
Office Version
  1. 2016
Platform
  1. MacOS
I have a VBA macro which prepares files to be able to be used. The last day or so, the splitting of the date has not worked properly and am wondering what might be wrong.

So the date comes from the data supplier as dd/mm/yyy hh:mm 24/11/2022 12:25:00. The macro has some code which adds an additional column and splits it so I have date and time separately. Both yesterday and today, once the macro was run, I had all the same time showing in the new column, but it should be whatever time was originally in column A

Below is a sample of the first 5 columns. What the code did with this data was create the new column as column B, but every cell in that column showed 12:25 as the time. Any thoughts on what is wrong, as it has worked fine for ages?

Here is the code

VBA Code: 
Sub Prepare_Files()
'
' Prepare_Files Macro
' This macro prepares files to run selection macros
'

'
        Dim ws As Worksheet, lc As Long, lr As Long

    Set ws = ActiveSheet
    'range from A1 to last column header and last row
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    lr = ws.Cells.Find("*", after:=ws.Range("A1"), LookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    With Application
            .ScreenUpdating = False
            .DisplayStatusBar = False
            .EnableEvents = False
    End With
        Columns("W:W").Select
        Selection.Insert Shift:=xlToRight
        Range("W2").Select
        ActiveCell.FormulaR1C1 = _
            "=IF(RC[-1]=""X"",""x"",IF(AND(RC[-3]=""X"",RC[-2]=""X""),""**"",""*""))"
        Range("W2").Select
        Application.Run "PERSONAL.XLSB!CopyFormulaDownToLastRowOfData"
        Columns("B:B").Select
        Selection.Insert Shift:=xlToRight
        Range("B1").Select
        ActiveCell.FormulaR1C1 = "Date"
        Columns("B:B").Select
        Selection.NumberFormat = "dd/mm/yyyy"
        Columns("C:C").Select
        Selection.Insert Shift:=xlToRight
        Range("C1").Select
        ActiveCell.FormulaR1C1 = "Time"
        Columns("C:C").Select
        Selection.NumberFormat = "hh:mm"
        Range("B2").Select
        ActiveCell.FormulaR1C1 = "=INT(A2)"
        Range("B2").Select
        ActiveCell.FormulaR1C1 = "=INT(RC[-1])"
        Range("B2").Select
        Application.Run "PERSONAL.XLSB!CopyFormulaDownToLastRowOfData"
        Range("C2").Select
        ActiveCell.FormulaR1C1 = "=(RC[-2]-RC[-1])"
        Range("C2").Select
        Application.Run "PERSONAL.XLSB!CopyFormulaDownToLastRowOfData"
        Columns("BV:BV").Select
        Selection.Insert Shift:=xlToRight
        Range("BV1").Select
        ActiveCell.FormulaR1C1 = "Forecast Rank"
        Range("BV2").Select
        ActiveCell.FormulaR1C1 = _
            "=IF(RC[-1]="""","""",COUNTIFS(C[-73],RC[-73],C[-72],RC[-72],C[-1],""<""&RC[-1])+1)"
        Range("BV2").Select
        Application.Run "PERSONAL.XLSB!CopyFormulaDownToLastRowOfData"
        Columns("A:A").Select
        Selection.Delete Shift:=xlToLeft
        With Application
            .ScreenUpdating = True
            .DisplayStatusBar = True
            .EnableEvents = True
    End With
End Sub


vdw-place-adapted-2022-11-24-2022-11-24.csv
ABCDE
1RH_DateAndTimeRH_RaceNameRH_NumberOfRunnersVDW_WinVDW_Place
211/24/22 12:25Download The At The Races App Conditional Jockeys' Handicap Hurdle87092
311/24/22 12:25Download The At The Races App Conditional Jockeys' Handicap Hurdle87092
411/24/22 12:25Download The At The Races App Conditional Jockeys' Handicap Hurdle87092
511/24/22 12:25Download The At The Races App Conditional Jockeys' Handicap Hurdle87092
611/24/22 12:25Download The At The Races App Conditional Jockeys' Handicap Hurdle87092
711/24/22 12:25Download The At The Races App Conditional Jockeys' Handicap Hurdle87092
811/24/22 12:25Download The At The Races App Conditional Jockeys' Handicap Hurdle87092
911/24/22 12:25Download The At The Races App Conditional Jockeys' Handicap Hurdle87092
1011/24/22 12:30Irish Stallion Farms EBF Beginners Chase973.1792.68
1111/24/22 12:30Irish Stallion Farms EBF Beginners Chase973.1792.68
1211/24/22 12:30Irish Stallion Farms EBF Beginners Chase973.1792.68
1311/24/22 12:30Irish Stallion Farms EBF Beginners Chase973.1792.68
1411/24/22 12:30Irish Stallion Farms EBF Beginners Chase973.1792.68
1511/24/22 12:30Irish Stallion Farms EBF Beginners Chase973.1792.68
1611/24/22 12:30Irish Stallion Farms EBF Beginners Chase973.1792.68
1711/24/22 12:30Irish Stallion Farms EBF Beginners Chase973.1792.68
1811/24/22 12:30Irish Stallion Farms EBF Beginners Chase973.1792.68
1911/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
2011/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
2111/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
2211/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
2311/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
2411/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
2511/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
2611/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
2711/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
2811/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
2911/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
3011/24/22 12:40Join Racing TV Now 'National Hunt' Novices' Hurdle (GBB Race) (Div 1)1180.85100
3111/24/22 12:48Racing TV Black Friday Is Coming Novices' Hurdle (GBB Race)980.85100
3211/24/22 12:48Racing TV Black Friday Is Coming Novices' Hurdle (GBB Race)980.85100
3311/24/22 12:48Racing TV Black Friday Is Coming Novices' Hurdle (GBB Race)980.85100
3411/24/22 12:48Racing TV Black Friday Is Coming Novices' Hurdle (GBB Race)980.85100
3511/24/22 12:48Racing TV Black Friday Is Coming Novices' Hurdle (GBB Race)980.85100
3611/24/22 12:48Racing TV Black Friday Is Coming Novices' Hurdle (GBB Race)980.85100
3711/24/22 12:48Racing TV Black Friday Is Coming Novices' Hurdle (GBB Race)980.85100
3811/24/22 12:48Racing TV Black Friday Is Coming Novices' Hurdle (GBB Race)980.85100
3911/24/22 12:48Racing TV Black Friday Is Coming Novices' Hurdle (GBB Race)980.85100
4011/24/22 12:48Racing TV Black Friday Is Coming Novices' Hurdle (GBB Race)980.85100
vdw-place-adapted-2022-11-24-20
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
What happens if you run the code below on a copy of your data?

VBA Code: 
Sub Prepare_Files2()
    '
    ' Prepare_Files Macro
    ' This macro prepares files to run selection macros
    '

    '
    Dim ws As Worksheet, lc As Long, lr As Long

    Set ws = ActiveSheet
    'range from A1 to last column header and last row
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    lr = ws.Cells.Find("*", after:=ws.Range("A1"), LookAt:=xlPart, _
                       SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
   
    Columns("W:W").Insert Shift:=xlToRight
    Range("W2:W" & lr).FormulaR1C1 = _
                                   "=IF(RC[-1]=""X"",""x"",IF(AND(RC[-3]=""X"",RC[-2]=""X""),""**"",""*""))"
     
    Columns("B:B").Insert Shift:=xlToRight
    Range("B1").Value = "Date"
    Columns("B:B").NumberFormat = "dd/mm/yyyy"
       
    Columns("C:C").Insert Shift:=xlToRight
    Range("C1").Value = "Time"
    Columns("C:C").NumberFormat = "hh:mm"
       
    Range("B2:B" & lr).FormulaR1C1 = "=INT(RC[-1])"
       
    Range("C2:C" & lr).FormulaR1C1 = "=(RC[-2]-RC[-1])"
      
    Columns("BV:BV").Insert Shift:=xlToRight
       
    Range("BV1").Value = "Forecast Rank"
    Range("BV2:BV" & lr).FormulaR1C1 = _
                                     "=IF(RC[-1]="""","""",COUNTIFS(C[-73],RC[-73],C[-72],RC[-72],C[-1],""<""&RC[-1])+1)"
       
    Columns("A:A").Delete Shift:=xlToLeft
       
    With Application
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

End Sub
 
Upvote 0
An update here; looks like it was the nut holding the wheel. I just realised when I ran the macro that I did not have Calculation Options set to Automatic. It was on Manual instead, so didn't correctly run the macro. Is there any way to have the macro set that just in case I forget?

cheers
 
Upvote 0
Rich (BB code): 
    With Application
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
        .Calculation = xlAutomatic
    End With
 
Upvote 0
honkin said:
Columns("A:A").Select
Click to expand...

honkin said:
Selection.Delete Shift:=xlToLeft
Click to expand...
Here is the problem.
Your "Date" and "Time" columns are formula, not value.
When we delete Column A (RH_DateAndTime), the two columns' formula become "#REF!".
If you want to delete Column A, your "Date" and "Time" columns should be value, not formula.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
Formula - Filtered Data (Horse Racing)
Replies
8
Views
4K
Peter_SSs
Peter_SSs
I
  • Solved
Sorted and calculating categories and totals maco
Replies
5
Views
384
shinigamilight
S
P
  • Question
Loop all macros every time button is clicked
Replies
1
Views
877
ranman256
ranman256
N
  • Question
VBA using INDEX and MATCH based on cell colour
Replies
0
Views
369
Nashpotatoes
N
E
  • Question
Problem with macro to copy vba to new workbook
Replies
0
Views
774
excel2007uk
E

Forum statistics

Threads
1,215,052
Messages
6,122,878
Members
449,097
Latest member
dbomb1414

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top