VBA to extract the 1st 2 words and a VBA for Date and Time

Wlk

New Member
Joined
Mar 19, 2020
Messages
14
Office Version
  1. 2013
Platform
  1. Windows
Hope everyone is safe and healthy!
I am totally new to VBA and I need some help.


Requirement# 1
I need a VBA to extract the first 2 words in a string. I got some guide online and I was only able to get the first word.

VBA Code:
Sub FirstWord()
' Disable key Excel properties whilst macro runs
        With Application
            .Calculation = xlCalculationManual
            .EnableEvents = False
            .ScreenUpdating = False
        End With
' Error handler
        On Error Resume Next
' Declare certain variables
        Dim rng As Range, cell As Range, location As Long
' set the range object
    Set rng = Selection
' loop code to go through all cells in the selection
    For Each cell In rng
    location = InStr(cell, " ") - 1
    cell = Left(cell, location)
    cell = Left(cell, InStr(cell, ",") - 1)
    Next cell
'move cursor to first cell in the selection
    ActiveCell.Select

'Re-enable excel properties
        With Application
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
            .ScreenUpdating = True
        End With

End Sub

Requirement #2
I have a column with Date & Time in this format ==> 2019-08-16 1:29:39 PM
I need to separate the Date and Time to another column
Another column to round the Time to the closest 15 mins
Another column to the closest hour.

I tried the below, it works for one cell:

VBA Code:
Public Sub SplitDateAndTime()
    Dim MyDateTime As Date
    MyDateTime = Range("B1").Value

    'get date
    Range("C1").Value = Int(MyDateTime)
    Range("C1").NumberFormat = "YYYY-MM-DD"

    'get time
    Range("D1").Value = MyDateTime - Int(MyDateTime)
    Range("D1").NumberFormat = "hh:mm:ss"
End Sub

Question
1. Can I combine the 2 requirements together, how do I do that?
2. Should I create separate modules for each of the requirement and create a button that run the 2 modules?

Sample Data to test, I have attached a screenshot of the desired output(Highlighted in yellow)
DateModel
2019-08-16 13:29​
Pluto Mickey House
2019-09-04 6:51​
Jane Bond
2019-10-01 14:47​
Dollar, Mister, West
2019-10-01 16:15​
Jacob, Total
2019-10-01 16:17​
Test Testca
2019-10-01 16:21​
2019-10-01 17:08​
2019-11-12 6:33​
2019-11-20 6:10​
2019-11-20 6:13​
2019-11-25 7:40​


Thanks in advance, I am really new to this.
 

Attachments

  • Desired output.PNG
    Desired output.PNG
    13.4 KB · Views: 17

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
This will give you the first 2 words in Cell into variable Z
VBA Code:
X = Trim(Cell)
Z = Left(x, InStr(InStr(x, " ") + 1, x, " ") - 1)

I have used an intermediate variable X to store the trimmed value in Cell.

So as not to complicate the coding, Trim will remove any leading and trailing spaces and intermediate double spaces, so that there is only one space between words.
 
Upvote 0
Trim will remove any leading and trailing spaces and intermediate double spaces,
It won't do the part in blue, for whatever reason the VBA version of Trim is different to the Xl version.
 
Upvote 0
Another option for part1
VBA Code:
Sub Wlk()
   Dim Cl As Range
   Dim Sp As Variant
   
   For Each Cl In Selection
      Sp = Split(Application.Trim(Cl.Value))
      If UBound(Sp) > 1 Then Cl.Value = Sp(0) & " " & Sp(1)
   Next Cl
End Sub
 
Upvote 0
Thanks both. I am really new to this. Should I create a new module with your VBAs or replaced a section of my current VBA? Thanks
 
Upvote 0
The code in post#4 replaces your code. So you van paste it into an existing module, or create a new module & paste it in that.
 
Upvote 0
Hi both, thank you very much. I am going to start learning VBA during this quarantine period :)
 
Upvote 0
Glad we could help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,214,590
Messages
6,120,423
Members
448,961
Latest member
nzskater

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