processing Array elements and writing to text file way too slow

[timemachine]

Hi guys,

I have a problem in getting this vba script to work a lot faster. Currently it take almost 30 minutes to run when processing a file that has about 115000 rows of data.
Reading from the file and filling up my array with the data takes about 30seconds it is the second part in which I process the elements and write back to a text file that takes all the time. I am pretty sure its because I check every element and then write each element separately to file instead of line by line or even chunk by chunk

The input file has data that is separated by a variable amount of white spaces and I am only interested in the 4 of the "columns", although this term is debatable when looking at the data.
Only the values in the B_Number, time of call, event and duration(sec) columns and also the second line in from the input file are required to be written into the new file.

-if the line begins with (B_Number column) an underscore ,"_" it is not to be processed and left out
-the time of call column should be converted to YYYY/MM/DD HH:MM format before writing to file


Input file looks like this.


Call details for msisdn XXXXXXXXXXX between 20130301 and 20130701


B_Number Time of call A_Number C_Number A_Carrier B_Carrier EVENT Call Type A_LOCATION B_LOCATION Duration (sec) Price Bonus Price
------------------ -------------- ------------------ ------------------ ------------------ ------------------ -------- ---------- ------------------ ------------------ -------- --------- --------
INTERNETBROWSING 20130301000014 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0 2.00
_ 20130301000023 _ _ _ _ UP _ _ _ _
_ 20130301000023 _ _ _ _ CR _ _ _ _
ZERORATEDGPRS 20130301001723 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
SOCIALNWK 20130301002053 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YYYYYYYYYY 20130301002111 XXXXXXXXXXX _ CarrierA _ VOICE MO _ _ 2691.0
ZZZZZZZZZZ 20130301002128 XXXXXXXXXXX _ CarrierA _ VOICE MO _ _ 2667.0
XXXXXXXXXXX 20130301003701 PPPPPPPPPP 0450076263 _ CarrierA VOICE CF _ _ 2.0 .20
WWWWWWWWWWW 20130301003738 XXXXXXXXXXX _ CarrierA _ SMS SMS _ _ .0
INTERNETBROWSING 20130301010757 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
ZERORATEDGPRS 20130301011352 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011416 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011424 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011432 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011440 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011447 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011455 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011503 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011513 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011519 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011527 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011535 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011543 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011551 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
SOCIALNWK 20130301011726 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
ZERORATEDGPRS 20130301011800 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011801 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301011910 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012020 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012031 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012040 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012047 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012055 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012103 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012111 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012129 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012135 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012141 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012146 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012154 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012223 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012238 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012250 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012256 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012313 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012345 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012359 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012418 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012446 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012517 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012525 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012530 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012603 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012623 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012632 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012643 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012651 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301012713 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
SOCIALNWK 20130301012901 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YOUTUBE 20130301012940 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YOUTUBE 20130301013047 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301013821 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301013826 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301013835 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301013838 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301013840 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301013843 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301013846 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301013850 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
INTERNETBROWSING 20130301013857 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
SOCIALNWK 20130301015657 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
_ 20130310000135 _ _ _ _ CR _ _ _ _
YOUTUBE 20130301015719 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YOUTUBE 20130301015736 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YOUTUBE 20130301015753 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YOUTUBE 20130301015809 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YOUTUBE 20130301015825 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YOUTUBE 20130301015842 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YOUTUBE 20130301015901 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YOUTUBE 20130301015918 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0
YOUTUBE 20130301015934 XXXXXXXXXXX _ CarrierA _ GPRS MO _ _ .0


OUtput file should look like

Call details for msisdn XXXXXXXXXX between 20130506 and 20130806

B Number Date Time Event Dur (Secs)
ZERORATEDGPRS 20/05/13 12:50 GPRS 0
SOCIALNWK 2013/05/13 13:46 GPRS 0
ZERORATEDGPRS 20/05/13 16:57 GPRS 0
YOUTUBE 2013/05/13 17:18 GPRS 0
YOUTUBE 2013/05/13 17:24 GPRS 0
YOUTUBE 2013/05/13 17:24 GPRS 0
YOUTUBE 2013/05/13 17:24 GPRS 0
YOUTUBE 2013/05/13 17:24 GPRS 0
YOUTUBE 2013/05/13 17:25 GPRS 0
YOUTUBE 2013/05/13 17:25 GPRS 0
SOCIALNWK 20/05/13 18:15 GPRS 0


the VBA code that I have is below

Sub Read_text_File()

    Dim fso As New FileSystemObject
    Dim cdrArr() As String
    Dim lineValues() As String
    Dim myLine, Line As String
    Dim ts As TextStream
    Dim fileStr As String
    Dim lineNum, colMax As Integer

    'open directory prompt for file
        fileStr = Application.GetOpenFilename()
        If fileStr = "False" Then Exit Sub
        Set ts = fso.OpenTextFile(fileStr, ForReading)
            
    'count the number of lines in the file first
        lineNum = 0
        maxColCount = 187
        totalLineCount = 1
        Do While ts.AtEndOfStream <> True
            Line = ts.readLine
            totalLineCount = totalLineCount + 1
        Loop
        
        ts.Close
        
    ' now fill our 2D array with the data from file
        ReDim Preserve cdrArr(totalLineCount - 1, maxColCount - 1)
        
        Set ts = fso.OpenTextFile(fileStr, ForReading)
        i = 0
        Do While ts.AtEndOfStream <> True
            myLine = ts.readLine
            lineValues = Split(myLine, " ")
            RowItems = UBound(lineValues)

                For j = 0 To RowItems
                    If IsNull(lineValues(j)) <> True Then
                        cdrArr(i, j) = lineValues(j)
                    End If
                Next
                i = i + 1
        Loop
        ts.Close
    ' now we have extracted our data from the log file into the array
    ' we need to create the text file
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        outfile = "c:\temp\CCR_" & Format(Now(), "mm_dd_yyyy_hh_mm") & ".txt"
        Set objFile = objFSO.CreateTextFile(outfile, True)
        'objFile.Write cdrArr

        arrUBound = UBound(cdrArr)
        arrLBound = LBound(cdrArr)
        
    ' print the header values of the file -> date range of search and MSISDN the search was run on 
        objFile.Write cdrArr(1, 0) & " " & cdrArr(1, 1) & " " & cdrArr(1, 2) & " " & cdrArr(1, 3) _
                                     & " " & cdrArr(1, 4) & " " & cdrArr(1, 5) & " " & cdrArr(1, 6) _
                                     & " " & cdrArr(1, 7) & " " & cdrArr(1, 8) & vbCrLf
    ' create the header
        objFile.Write vbCrLf & "B Number" & vbTab & "Date/Time" & vbTab & "Event" & vbTab & "Duration(sec)" & vbCrLf
        objFile.Write "-------------------------------------------" & vbCrLf
        
    ' go through 2D array and check each element before writing to file
        For k = 7 To arrUBound
            For m = 0 To 186
                If cdrArr(k, 0) = "_" Then
                    Exit For
                ElseIf m = 0 Then
                    objFile.Write cdrArr(k, m) & vbTab
                ' skip any null or empty elements
                ElseIf IsNull(cdrArr(k, m)) <> True Or IsEmpty(cdrArr(k, m)) <> True Or cdrArr(k, m) <> " " Then
                    ' run regex function
                    If parseElements(cdrArr(k, m)) = True Then
                        objFile.Write cdrArr(k, m) & vbTab
                    End If
                End If
            Next
            objFile.Write vbCrLf
        Next
        
        objFile.Close
    
        
    


End Sub

' we only want to print these values from the array
Function parseElements(arrElement) As Boolean
        Dim regEx As New RegExp
        regEx.Pattern = "[0-9]{14}|^VOICE|^GPRS|^SMS|^(\d*\.0)"
        regEx.IgnoreCase = True 'True to ignore case
        regEx.Global = True 'True matches all occurances, False matches the first occurance
        If regEx.Test(arrElement) Then
            parseElements = True
        Else
            parseElements = False
        End If

End Function