Ytukyg

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 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

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