How to use multiple function/formula on VBA

Question

I'm new using VBA and I'm trying to code into VBA but it didn't work so far, my timestamp data is not common and I got 10000+ rows to do the same formula (sometime excel just crash so i would like to try VBA)

timestamp that I tried split

Edit : add code

Sub Split_text_3()
        Dim p As String
        For x = 1 To 6 '---How do it until last cell?
            Cells(x, 2).Value = Mid(Cells(x, 1).Value, 9, 2) 'combind in same cell
            Cells(x, 3).Value = Mid(Cells(x, 1).Value, 5, 3) 'combind in same cell
            Cells(x, 4).Value = Mid(Cells(x, 1).Value, 21, 4) 'combind in same cell
            Cells(x, 5).Value = Mid(Cells(x, 1).Value, 12, 8) 
    Next x End Sub

and the data look like this (I tried to separate it first and then might try to combine them later)
image

convert your data to string in vba, use msgbox to see what value do you have, and after that use right, left, mid functions to extract date units. — Yuri Molodyko
– Yuri Molodyko, Commented Sep 10, 2021 at 9:06
Without code, it is very hard to help you. Please include the code you have tried. We can only help you to fix the code if we can see it. • Also note that VBA might even be slower that formulas. — Pᴇʜ
– Pᴇʜ, Commented Sep 10, 2021 at 9:13
Are those dates in the left column numeric dates or text/string? — Pᴇʜ
– Pᴇʜ, Commented Sep 10, 2021 at 9:29
its text in all column, in order to do this properly where do I start with the data in left cell? — alpha
– alpha, Commented Sep 10, 2021 at 9:46

FaneDuru · Accepted Answer · 2021-09-13 12:43:59Z

1

Please, try the next function:

Function extractDateTime(strTime As String) As Variant
   Dim arrD, d As Date, t As Date
   arrD = Split(strTime, " ")
   d = CDate(arrD(2) & "/" & arrD(1) & "/" & arrD(4))
   t = CDate(arrD(3))
   extractDateTime = Array(d, t)
End Function

It can be tested in the next way:

Sub testExtractDate()
  Dim x As String, arrDate
  x = "WED SEP 08 08:13:52 2021"
  arrDate = extractDateTime(x)
  Debug.Print arrDate(0), arrDate(1)
End Sub

If it returns as you need (I think, yes...), you can use the next function to process the range. It assumes that the column keeping the strings are A:A, and returns in C:D:

Sub useFunction()
   Dim sh As Worksheet, lastR As Long, Arr, arrDate, arrFin, i As Long
   
   Set sh = ActiveSheet
   lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
   Arr = sh.Range("A2:A" & lastR).Value
   If IsArray(Arr) Then
        ReDim arrFin(1 To UBound(Arr), 1 To 2)
        For i = 1 To UBound(Arr)
             If Arr(i, 1) <> "" Then
                 arrDate = extractDateTime(CStr(Arr(i, 1)))
                 arrFin(i, 1) = arrDate(0): arrFin(i, 2) = arrDate(1)
             End If
        Next i
        sh.Range("C2").Resize(UBound(arrFin), 2).Value = arrFin
   Else
        sh.Range("C2:D2").Value = extractDateTime(CStr(sh.Range("A2").Value))
   End If
End Sub

edited Sep 13, 2021 at 12:43

answered Sep 10, 2021 at 10:01

FaneDuru

42.3k4 gold badges22 silver badges30 bronze badges

Sign up to request clarification or add additional context in comments.

9 Comments

alpha Over a year ago

Thanks, I will try to use on my sheet (might take some times.)

alpha Over a year ago

I got some problem with 1 row data on excel (other rows got delete by other module due to unnecessary) ReDim arrFin(1 To UBound(arr), 1 To 2) eg. only A2 have WED MAR 24 05:22:22 202 Is there anyway to make it work with 1 line as well?

FaneDuru Over a year ago

@alpha I am not sure I understand what you want... Do you mean that only a row to be processed remained and the code returns an error? If so, is it the second row? If yes, I can adapt the code to deal with this situation, too, but I need your confirmation that my supposition/understanding is correct...

alpha Over a year ago

yes 'only a row to be processed remained and the code returns an error'

FaneDuru Over a year ago

@alpha And this "one row" is the second one... I will adapt the code.

|

kamikadze366 · Accepted Answer · 2021-09-10 12:10:21Z

1

I think I have another solution (not bulletproof) but it is simplier, quicker and code less solution (no offense FraneDuru!):

Sub DateStamp()
    Dim arr, arr_temp, arr_new() As Variant
    Dim i As long
    
    'Take cells from selected all the way down to 1st blank cell
    'and assign values to an array
    arr = ThisWorkbook.ActiveSheet.Range(Selection, Selection.End(xlDown)).Value
    
    ReDim Preserve arr_new(1 To UBound(arr), 1 To 2)

    For i = 1 To UBound(arr)
        'Make another array by spliting input string by whitespace delimiter (default)
        arr_temp = Split(arr(i, 1))
        
        'Construct values in desired "format"
        arr_new(i, 1) = "'" & arr_temp(2) & "/" & arr_temp(1) & "/" & arr_temp(4)
        arr_new(i, 2) = arr_temp(3)
    Next i
    
    'Paste result into Excel
     Selection.Offset(0, 1).Resize(UBound(arr), 2) = arr_new
End Sub

All you have to do is to select the cell toy want to start with and run the macro! :)

Bellow also a picture with watches, so you can catch-up what is going on:

edited Sep 10, 2021 at 12:10

answered Sep 10, 2021 at 11:04

kamikadze366

1561 silver badge6 bronze badges

6 Comments

FaneDuru Over a year ago

It cannot be faster. And using so many 'Redim Preserve' is a bad memory handling way. Selection is enen a worst way, which only consumes excel resources and does not bring any benefit... Did you test the code. You can Redim Preserve oly the last array dimension.

FaneDuru Over a year ago

And using redim preserve for the same number of elements is completelly uselesd, except the memory stress...

Raymond Wu Over a year ago

You should declare i as Long too since it can potentially end up with a number bigger than whatInteger can hold thus causing overflow

kamikadze366 Over a year ago

I agree with your comments, edited. Redim only once. @FaneDuru, FYI your code works if your system language is english, otherwise it throws "Type mismatch" error when executing line: d = CDate(arrD(2) & "/" & arrD(1) & "/" & arrD(4)) Execution time for 1048576 rows (max Excel can handle) is around 6,285 seconds.

alpha Over a year ago

Thanks @kamikadze366 for the explanation.

|

Collectives™ on Stack Overflow

How to use multiple function/formula on VBA

2 Answers 2

9 Comments

6 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

9 Comments

6 Comments

Your Answer

Sign up or log in

Post as a guest

Related