Convert tabular data into subtitle text file format (.srt) UTF-8

Question

I have stock market data in excel that I wish to convert it into a text file with Encoding UTF-8 and Extension .srt which seems to be a very difficult task for me to achieve. I know how to convert an excel file into a textfile but in this case, processing needs to be done before conversion and that seems to be a little hectic. What I need to do is that bring tabular data in one column (one below the other) considering few rules. I dont know how to explain my query in text and that is why I am attaching an screenshot of the excel file. In the attached excel file screenshot, the tabular data is highlighted in green and how to converted data would look like is highlighted in yellow. Instructions on how the data needs to be processed is written in blue text.

This is just a sample data. The original would data would be bigger in size. In the sample data under Equity heading there are 6 companies, under Mutual Funds, 1 company and under Foreign Exchange, there is 1 but in real data, there would be more categories and more data within each category (in sample data there are only 3 categories). Can some one give me a push on how this can be achieved in Excel VBA

I posted this on excelforum but did not receive any reply. Appreciate some help. ExcelForum link here

Thanks

Thanks.

You are making a group of 3 companies in each serial, is this the case in your actual data as well? — usmanhaq, Nov 24 '18 at 14:55
Yes, actual data would also be of 3 companies. Thanks for looking into it. — Sabha, Nov 24 '18 at 15:05
I am not familiar with the creation of `.srt` files. Do the empty/blank rows (in the output) hold any significance (would the subtitles be any different if these rows were deleted)? Also, what is the logic behind the time durations? They seem to be 9 seconds apart, apart from rows 1 and 74. — chillin, Nov 24 '18 at 15:08
Yes it does... Blank rows means a line feed for next subtitle to appear below. Blank space means end of first subtitle screen. If the rows are deleted, it would not be seen the way I want it to. There has to be equal time duration. I made a mistake there. The last one should have been 00:00:56,000 --> 00:01:05,000. Only the first time duration would be of 4 seconds. Hope I have answered your queries — Sabha, Nov 24 '18 at 15:20
I think i did not explain properly. Where there is blank space that means a line feed is required after that line and black row (without space) is end of first subtitile. I hope there is no confusion — Sabha, Nov 24 '18 at 15:46

usmanhaq · Accepted Answer · 2018-11-26T01:25:28.557

You can test this code, i have tested it on your provided data, but for your actual data it may require some minor adjustments; i believe you can do that.

Sub extract_data()

    Dim i, j, data_row As Long
    Dim serial_num As Long
    Dim time_start, time_end As Double

    time_start = TimeSerial(0, 0, 1)
    time_end = TimeSerial(0, 0, 5)

    time_str = Format(time_start, "HH:MM:SS") & ",000 --> " & Format(time_end, "HH:MM:SS") & ",000"

    lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    serial_num = 1

    data_row = 1

    For i = 1 To lastRow

        If Range("B" & i).Value = "" Then

            Range("F" & data_row).Value = serial_num
            serial_num = serial_num + 1
            data_row = data_row + 1
            Range("F" & data_row).Value = time_str
            data_row = data_row + 6
            Range("F" & data_row).Value = Range("A" & i).Value
            data_row = data_row + 6
        Else

            Range("F" & data_row).Value = serial_num
            serial_num = serial_num + 1
            data_row = data_row + 1
            time_start = time_end + TimeSerial(0, 0, 1)
            time_end = time_start + TimeSerial(0, 0, 9)
            time_str = Format(time_start, "HH:MM:SS") & ",000 --> " & Format(time_end, "HH:MM:SS") & ",000"
            Range("F" & data_row).Value = time_str


            For j = i To i + 2

                data_row = data_row + 1
                Range("F" & data_row).Value = Range("A" & j).Value

                high_low_close = "High : " & Range("B" & j).Value & " " & _
                                 "Low : " & Range("C" & j).Value & " " & _
                                 "Close : " & Range("D" & j).Value

                data_row = data_row + 1
                Range("F" & data_row).Value = high_low_close
                data_row = data_row + 1

            Next

            i = j - 1
            data_row = data_row + 1

         End If

   Next

End Sub

Thank you so much. I tried it and it works the way I want it except for the exporting to .srt file which I will do it. The thing which was missing was the `,000` concatenation after the time durations. Rest all is fine. Thanks for giving time into my query. God bless ! — Sabha, Nov 25 '18 at 16:23
Yes I did that already as it was very easy to do. Thank you for your valuable time to look into my problem. Both of you guys have saved a lot of my time. Thanks a ton. — Sabha, Nov 26 '18 at 08:11

Dy.Lee · Answer 2 · 2018-11-26T12:08:43.070

Try

Sub test()
    Dim vDB, vR()
    Dim s As String, s2 As String
    Dim sT As Integer, sE As Integer, co As Integer
    Dim str As String, strResult As String
    Dim i As Long, n As Long, c As Long, r As Long
    Dim num As Long
    Dim T1 As String, T2 As String
    Dim strFn As String

    s = vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
    s2 = "," & Format(0, "000")

    vDB = Range("a1").CurrentRegion
    n = UBound(vDB, 1)
    sT = 1
    For i = 1 To n
        If vDB(i, 2) = "" Then
            num = num + 1
            c = c + 5
            If num = 1 Then
                sE = sT + 4
            Else
                sT = sE + 1
                sE = sT + 9
            End If
            T1 = Format(TimeSerial(0, 0, sT), "hh:mm:ss")
            T2 = Format(TimeSerial(0, 0, sE), "hh:mm:ss")
            ReDim Preserve vR(1 To c)
            vR(c - 4) = num
            vR(c - 3) = T1 & s2 & "-->" & T2 & s2
            vR(c - 2) = s
            vR(c - 1) = vDB(i, 1)
            vR(c) = s
        Else
            r = r + 1
            If r = 1 Then
                num = num + 1
                c = c + 4
                sT = sE + 1
                sE = sT + 9
                T1 = Format(TimeSerial(0, 0, sT), "hh:mm:ss")
                T2 = Format(TimeSerial(0, 0, sE), "hh:mm:ss")
                ReDim Preserve vR(1 To c)
                vR(c - 3) = num
                vR(c - 2) = T1 & s2 & "-->" & T2 & s2
                vR(c - 1) = vDB(i, 1)
                vR(c) = "High:" & vDB(i, 2) & " Low:" & vDB(i, 3) & " Close:" & vDB(i, 4) & vbCrLf
            Else
                c = c + 2
                 ReDim Preserve vR(1 To c)
                vR(c - 1) = vDB(i, 1)
                vR(c) = "High:" & vDB(i, 2) & " Low:" & vDB(i, 3) & " Close:" & vDB(i, 4) & vbCrLf
                If r = 3 Then r = 0
            End If
        End If
    Next i
    strResult = Join(vR, vbCrLf)
    Range("f1").Resize(UBound(vR)) = WorksheetFunction.Transpose(vR)
    '@@ Save Text file
    strFn = "Test1.srt"
    strFn = ThisWorkbook.Path & "\" & strFn

    TransToUTF strResult, strFn 'make srt file
End Sub
Sub TransToUTF(strTxt As String, strFile As String)
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")

    With objStream
        .Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile strFile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

You got satisfactory answers from others, but I corrected my answers. Displaying the results on a sheet will be time consuming. It will also add a lot of data. Why it's good to use arrays is the focus of this site. Refer This

Sub test()
    Dim vDB, vR()
    Dim s As String, s2 As String, s3 As String
    Dim sT As Integer, sE As Integer, co As Integer
    Dim str As String, strResult As String
    Dim i As Long, n As Long, c As Long, r As Long
    Dim num As Long
    Dim T1 As String, T2 As String
    Dim strFn As String


    s = WorksheetFunction.Rept(Space(1) & vbCrLf, 4) & Space(1)
    s2 = "," & Format(0, "000")
    s3 = WorksheetFunction.Rept(Space(1) & vbCrLf, 4)

    vDB = Range("a1").CurrentRegion
    n = UBound(vDB, 1)
    sT = 1
    For i = 1 To n
        If vDB(i, 2) = "" Then
            num = num + 1
            c = c + 5
            If num = 1 Then
                sE = sT + 4
            Else
                sT = sE + 1
                sE = sT + 9
            End If
            T1 = Format(TimeSerial(0, 0, sT), "hh:mm:ss")
            T2 = Format(TimeSerial(0, 0, sE), "hh:mm:ss")
            ReDim Preserve vR(1 To c)
            vR(c - 4) = num
            vR(c - 3) = T1 & s2 & " --> " & T2 & s2
            vR(c - 2) = s
            vR(c - 1) = vDB(i, 1)
            vR(c) = s3
        Else
            r = r + 1
            If r = 1 Then
                num = num + 1
                c = c + 4
                sT = sE + 1
                sE = sT + 9
                T1 = Format(TimeSerial(0, 0, sT), "hh:mm:ss")
                T2 = Format(TimeSerial(0, 0, sE), "hh:mm:ss")
                ReDim Preserve vR(1 To c)
                vR(c - 3) = num
                vR(c - 2) = T1 & s2 & " --> " & T2 & s2
                vR(c - 1) = vDB(i, 1)
                vR(c) = "High:" & vDB(i, 2) & " Low:" & vDB(i, 3) & " Close:" & vDB(i, 4) & vbCrLf & Space(1)
            Else
                c = c + 2
                 ReDim Preserve vR(1 To c)
                vR(c - 1) = vDB(i, 1)
                vR(c) = "High:" & vDB(i, 2) & " Low:" & vDB(i, 3) & " Close:" & vDB(i, 4) & vbCrLf & Space(1)
                If r = 3 Then r = 0
            End If
        End If
    Next i
    strResult = Join(vR, vbCrLf)
    '@@ This not need. This is just for reviewing the results of the code on the sheet.
        'Range("f1").Resize(UBound(vR)) = WorksheetFunction.Transpose(vR)
    '@@ Save Text file
    strFn = "Test1.srt"
    strFn = ThisWorkbook.Path & "\" & strFn

    TransToUTF strResult, strFn 'make srt file
End Sub
Sub TransToUTF(strTxt As String, strFile As String)
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")

    With objStream
        .Charset = "utf-8"
        .Open
        .WriteText strTxt
        .SaveToFile strFile, 2
        .Close
    End With
    Set objStream = Nothing

End Sub

Thanks a lot for your help. I just tried it and it works well except for few things. 1. In screen no.1,4&6, it create additional spaces. 2. By blank space I meant a "space character" (spacebar) and by blank line I meant an emply line without a space character. 3. I wanted a space before an after the `-->`. Nevertheless, I will modify that part somehow. Thanks for you assistance. Really appreciate it ! — Sabha, Nov 25 '18 at 16:21
@Sabha, Do you mean that blank space is spacebar without blank line? — Dy.Lee, Nov 25 '18 at 20:30
Thank you for your reply. Where the first screen end and before start of second screen there is a blank line without spacebar character but within the screens, every line should have a spacebar character. I have edited your code to suit my desire and it works fine. As far as understanding the code, I would have loved to accept both the answer but the system does not allow that. For me understanding arrays is a bit difficult and I found the solution by @usmanhaq easier to understand and that is why i am accepting his solution. Thank you so much for your time and assistance. God bless ! — Sabha, Nov 26 '18 at 08:10

Convert tabular data into subtitle text file format (.srt) UTF-8

2 Answers2