Transpose Varying Colums

Hi all, I'm a basic VBAer but this one has me stumped. I basically have a single column of data that I wish to convert to multiple columns.
Any assistance would be greatly appreciated.
Thank you.


From this (1 Column):

Race #13289347
Class*1
3500m
23/02/2022 10:32
3rd
26
Race #13288620
Class*1
3500m
23/02/2022 10:30
11th
Race #13287919
Class*1
3500m
23/02/2022 10:28
3rd
26
Race #13286369
Class*1
4000m
23/02/2022 10:23
6th
Race #13283093
Class*1
3500m
23/02/2022 10:10
11th
Race #13281097
Class*1
4000m
23/02/2022 10:03
6th
Race #13260386
Class*1
3500m
23/02/2022 8:32
2nd
44


To this (6 Columns):

Race #13289347 | Class*1 | 3500m | 23/02/2022 10:32 | 3rd | 26
Race #13260386 | Class*1 | 3500m | 23/02/2022 8:32 | 2nd | 44
Race #13281097 | Class*1 | 4000m | 23/02/2022 10:03 | 6th |
Race #13283093 | Class*1 | 3500m | 23/02/2022 10:10 | 11th |
Race #13286369 | Class*1 | 4000m | 23/02/2022 10:23 | 6th |
Race #13287919 | Class*1 | 3500m | 23/02/2022 10:28 | 3rd | 26
Race #13288620 | Class*1 | 3500m | 23/02/2022 10:30 | 11th |

Try

Sub test()
    Dim x, i As Long, ii As Long, txt As String
    With Sheets("sheet1")
        x = Filter(.[transpose(if(left(a1:a10000,4)="Race",row(1:10000)))], False, 0)
        If UBound(x) = -1 Then Exit Sub
        ReDim Preserve x(UBound(x) + 1)
        x(UBound(x)) = .Range("a" & Rows.Count).End(xlUp)(2).Row
        For i = 0 To UBound(x) - 1
            For ii = x(i) To x(i + 1) - 1
                txt = txt & Chr(2) & .Cells(ii, 1)
            Next
            x(i) = Mid$(txt, 2): txt = ""
        Next
        With .[c1].Resize(UBound(x))
            .CurrentRegion.ClearContents
            .Value = Application.Transpose(x)
            .TextToColumns .Cells(1), 1, Other:=True, OtherChar:=Chr(2)
            '.CurrentRegion.Sort .Cells(1)
        End With
    End With
End Sub

You are welcome.

I've realised this this actually swaps the Day and Month in the date. I've traced through the code and found that it transposes correctly but when it runs the TextToColumns it swaps the date and month. Any help is greatly appreciated. Thanks.


From:
Race #20863804
Class*1
3500m
10/03/2022 11:09
1st
105

To:
Race #20863804 Class*1 3500m 3/10/2022 11:09 1st 105

Try change bold line if this does not work as you expected.

Sub test()
    Dim x, i As Long, ii As Long, txt As String, temp
    With Sheets("sheet1")
        x = Filter(.[transpose(if(left(a1:a10000,4)="Race",row(1:10000)))], False, 0)
        If UBound(x) = -1 Then Exit Sub
        ReDim Preserve x(UBound(x) + 1)
        x(UBound(x)) = .Range("a" & Rows.Count).End(xlUp)(2).Row
        For i = 0 To UBound(x) - 1
            For ii = x(i) To x(i + 1) - 1
                temp = .Cells(ii, 1)
                If temp Like "##/##/#### *" Then
                    temp = Format$(DateSerial(Mid$(temp, 7, 4), Left$(temp, 2), Mid$(temp, 4, 2)) _
                        + TimeValue(Split(temp)(1)), "m/d/yyyy hh:mm")  '<--- change like d/m/yyyy if doesn't work...
                End If
                txt = txt & Chr(2) & temp
            Next
            x(i) = Mid$(txt, 2): txt = ""
        Next
        With .[c1].Resize(UBound(x))
            .CurrentRegion.ClearContents
            .Value = Application.Transpose(x)
            .TextToColumns .Cells(1), 1, Other:=True, OtherChar:=Chr(2)
            '.CurrentRegion.Sort .Cells(1)
        End With
    End With
End Sub

Perfect! Thank you so so so much again.

While this works for double digit dates, it doesn't for single digits.

Eg.
From (is currently correct for me 7/03/2022 (7th March):
Race #19240886
Class*1
3500m
7/03/2022 9:00
1st
105

To:
Race #19240886 Class*1 3500m 3/07/2022 9:00 1st 105


Sorry to keep asking for help. I have seriously tried Google and trial and error to fix this myself but I just don't have the skills (yet!).

Originally Posted by TravNoob

Race #13260386
Class*1
3500m
23/02/2022 8:32
2nd
44


To this (6 Columns):

Race #13288620 | Class*1 | 3500m | 23/02/2022 10:30 | 11th |

Originally Posted by TravNoob

From (is currently correct for me 7/03/2022 (7th March):
Race #19240886
Class*1
3500m
7/03/2022 9:00
1st
105

To:
Race #19240886 Class*1 3500m 3/07/2022 9:00 1st 105

Confusing...

Are you saying that my threads are confusing? Sorry about that.

The first one in your reply was an example of what I want to happen and the second example is what your script does. Your script works fine for double digit dates say '23/02/2022' but not for single digit 7/03/2022 (7 March 2022).

See pic for an example of your script in action.

No, your output.

23/02/2022 10:32 to 23/02/2022 10:32 in post #1
7/03/2022 9:00 to 3/07/2022 9:00 in post #8

Apologies. I'm not explaining myself clear enough.

I've attached a sample spreadsheet with the script, if you run it you can see it transposes 10/03 perfectly which is what I'm after. However it changes 9/03 to 3/09 which is not what I want.


Thanks for bearing with me. Your help is so very appreciated.

You know the dates in Excel is terrible.

Here A4 shows as 2022/3/10 14:34:00 both in cell and formula bar.
That means it is genuine date and time.

How is it showing there?

Oh. Our setting differences would make this more difficult. Here is my screenshot.

And formula bar appears as "10/03/2022 2:34:00 PM".

OK.

Is the data imported from text file?
If so, it is better/safer to read the data directly from text file.

It's copied from a webpage and I paste it into excel with "Match Destination Formatting".

Can you copy it to text editor like NotPad?

Once you pasted to Excel, it automatically convert to appropriate data types, called auto casting, that I hate sometime...

Ok. So I did that and confirmed that all the cells in Column A are text. Still getting the same result unfortunately.

No,,,
What I'm trying to say is that once you pasted the data in text editor, read the data directly from the text file and process before output to Excel by vba.
So can you upload the text file here?

You guys are amazing! How do you do this in so little code! This works, just a minor formatting issue as the date/time transposes as text.

Still blown away at how skilled you guys are.

Originally Posted by TravNoob

This works, just a minor formatting issue as the date/time transposes as text.

Are you saying the date/time column is posting as text, not a real date/time? If so, is the day/month order correct? Let me know and I'll attempt to "fix" it (but first I need to know the actual problem).

Sorry, I'm unsure what you mean. I've just grabbed a section from the website and pasted it into notepad. Attached is the text file.

We posted at nearly the same time so you might have missed my posting. See Message #21 -- right before your last post.

The 'F' column is displayed as the 'raw' date/time "44630.61181".
Also it would be great to have the output sorted by Column C (smallest number on top).

The date/time is correct, just wrong format.

This will :

Show converted joined data in Col.A and separate it from col.C.

See if this works.

Sub test()
    Dim fn As String, a, x, y, z, i As Long, ii As Long, n As Long, temp
    fn = Application.GetOpenFilename("TextFiles,*.txt")
    x = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll, vbNewLine)
    ReDim a(1 To UBound(x) + 1, 1 To 1)
    For i = 0 To UBound(x)
        If x(i) Like "Race [#]#*" Then
            n = n + 1: ii = 0
            Do
                temp = x(i + ii)
                If temp <> "" Then
                    If temp Like "*:* */*/*" Then
                        y = Split(temp)
                        z = Split(y(1), "/")
                        temp = Format$(DateSerial(z(2), z(1), z(0)) + TimeValue(y(0)), "dd/mm/yyyy hh:mm")
                    End If
                    a(n, 1) = a(n, 1) & Chr(2) & temp
                End If
                ii = ii + 1
                If i + ii > UBound(x) Then Exit Do
            Loop Until x(i + ii) Like "Race [#]#*"
            a(n, 1) = Mid$(a(n, 1), 2)
            i = i + ii - 1
        End If
    Next
    With [a1].Resize(n)
        .Value = a
        .TextToColumns .Cells(1, 3), 1, Other:=True, OtherChar:=Chr(2)
    End With
End Sub

Originally Posted by jindon

This will :

Show converted joined data in Col.A and separate it from col.C.

See if this works.

Sub test()
    Dim fn As String, a, x, y, z, i As Long, ii As Long, n As Long, temp
    fn = Application.GetOpenFilename("TextFiles,*.txt")
    x = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll, vbNewLine)
    ReDim a(1 To UBound(x) + 1, 1 To 1)
    For i = 0 To UBound(x)
        If x(i) Like "Race [#]#*" Then
            n = n + 1: ii = 0
            Do
                temp = x(i + ii)
                If temp <> "" Then
                    If temp Like "*:* */*/*" Then
                        y = Split(temp)
                        z = Split(y(1), "/")
                        temp = Format$(DateSerial(z(2), z(1), z(0)) + TimeValue(y(0)), "dd/mm/yyyy hh:mm")
                    End If
                    a(n, 1) = a(n, 1) & Chr(2) & temp
                End If
                ii = ii + 1
                If i + ii > UBound(x) Then Exit Do
            Loop Until x(i + ii) Like "Race [#]#*"
            a(n, 1) = Mid$(a(n, 1), 2)
            i = i + ii - 1
        End If
    Next
    With [a1].Resize(n)
        .Value = a
        .TextToColumns .Cells(1, 3), 1, Other:=True, OtherChar:=Chr(2)
    End With
End Sub

This incorrectly swaps the month and the date around for all entries, plus has the added step of opening the text file.
Really interesting way of doing things, haven't seen this before.

I modified my original code a little as I realized I left some unqualified ranges. This code below fixes that, sorts your data as requested and attempts (because I cannot test your date ordering in my locale) to make the date/times real date/times instead of text... let me know if it worked or not.

Sub SingleColumnToMultipleColumns()
  Dim Txt As String, Arr As Variant
  With Sheets("Sheet2")
    Arr = Split(Replace(Join(Application.Transpose(.Range("A1", Cells(Rows.Count, "A").End(xlUp))), Chr(1)), Chr(1) & "Race", Chr(8) & "Race"), Chr(8))
    .Range("C1").CurrentRegion.Clear
    .Range("C1").Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
    .Columns("C").TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
    .Range("C1").CurrentRegion.Sort .Columns("C"), xlAscending
    With .Range("F1", .Cells(Rows.Count, "F").End(xlUp))
      .Value = .Value
    End With
  End With
End Sub

Then try change

                        temp = Format$(DateSerial(z(2), z(1), z(0)) + TimeValue(y(0)), "dd/mm/yyyy hh:mm")

to

                        temp = Format$(DateSerial(z(2), z(1), z(0)) + TimeValue(y(0)), "dd/mm/yyyy hh:mm")

Originally Posted by jindon

Then try change

                        temp = Format$(DateSerial(z(2), z(1), z(0)) + TimeValue(y(0)), "dd/mm/yyyy hh:mm")

to

                        temp = Format$(DateSerial(z(2), z(1), z(0)) + TimeValue(y(0)), "dd/mm/yyyy hh:mm")

Swapped the "1" and the "0" and added the sort command from you previous script and it works great. Thanks so much for your effort. Still have that extra step of opening up the TXT file but it works. Thanks again!

OK, finally.
As I said

Is the data imported from text file?
If so, it is better/safer to read the data directly from text file.

Okay, let me try one more time to get the date/time to display correctly (you still have to tell me if the day and month translate correctly though)...

Sub SingleColumnToMultipleColumns()
  Dim Txt As String, Arr As Variant
  With Sheets("Sheet2")
    Arr = Split(Replace(Join(Application.Transpose(.Range("A1", Cells(Rows.Count, "A").End(xlUp))), Chr(1)), Chr(1) & "Race", Chr(8) & "Race"), Chr(8))
    .Range("C1").CurrentRegion.Clear
    .Range("C1").Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
    .Columns("C").TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
    .Range("C1").CurrentRegion.Sort .Columns("C"), xlAscending
    With .Range("F1", .Cells(Rows.Count, "F").End(xlUp))
      .Value = .Value
      .NumberFormat = "dd/mm/yyyy hh:mm:ss"
    End With
  End With
End Sub

Originally Posted by Rick Rothstein

Okay, let me try one more time to get the date/time to display correctly (you still have to tell me if the day and month translate correctly though)...

Sub SingleColumnToMultipleColumns()
  Dim Txt As String, Arr As Variant
  With Sheets("Sheet2")
    Arr = Split(Replace(Join(Application.Transpose(.Range("A1", Cells(Rows.Count, "A").End(xlUp))), Chr(1)), Chr(1) & "Race", Chr(8) & "Race"), Chr(8))
    .Range("C1").CurrentRegion.Clear
    .Range("C1").Resize(UBound(Arr) + 1) = Application.Transpose(Arr)
    .Columns("C").TextToColumns , xlDelimited, , , False, False, False, False, True, Chr(1)
    .Range("C1").CurrentRegion.Sort .Columns("C"), xlAscending
    With .Range("F1", .Cells(Rows.Count, "F").End(xlUp))
      .Value = .Value
      .NumberFormat = "dd/mm/yyyy hh:mm:ss"
    End With
  End With
End Sub

Works perfectly. Thank you!
Very fast and clean.