Getting Text File data after Instr is true and splitting-CodePudding

I attached a copy of a sample text file. I am have a code that finds the storeID and Date which are on the first line (StoreID = 101190 and Date is = 112421). In a cell on the worksheet I have the storeID and Date combined. I have the code below that I was able to put together but that gets me to the end of the line. I would like to get from the date cell value to "99 END OF DAY". I want lines 12 and 13A to be split as each value represents a payment. Then Disposal Fee line and safety Inspection line to be split as well. How can I implement this? Any help would be appreciated. I put a google drive link to a File sample that contains 3 dates. Usually the file contains all the Data from couple of years back so it is a long file.

 Sub GetDailySalesFromAutoData()
  todaysdate = ThisWorkbook.Worksheets("Sheet1").Range("A2").Value
  todaysdate2 = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value & Format(todaysdate, "mmddyy")


sFile = "C:\Users\axela\Desktop\FileSample.txt"
 
Dim objFSO As Object
Dim objTextFile As Object
Dim lngCount As Long, i As Long
Dim FileNum As Integer
Dim DataLine As String
Dim strFound As String
Dim bFound As Boolean
Dim vLine As Variant
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        Set objTextFile = objFSO.OpenTextFile(sFile, ForReading, -1)
    
Do While Not objTextFile.AtEndOfStream
        lngCount = lngCount   1    'increment a counter'
         ' read in data 1 line at a time'
         DataLine = objTextFile.ReadLine
        If InStr(1, DataLine, todaysdate2) > 0 Then    'the string is found'
            bFound = True    'set a boolean value to true'
            Exit Do    'and stop the loop'
        End If
    Loop
     
    If bFound = True Then    'The text string was found'
        'Read through the file line by line to the line after the found line'
    
        For i = 1 To lngCount
        Do While Not objTextFile.AtEndOfStream
            strFound = objTextFile.ReadLine
            strFound = Trim(strFound)
            ThisWorkbook.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = strFound

       Loop
        Next i
       
        objTextFile.Close    'close the file'
        Set objFSO = Nothing
        Set objTextFile = Nothing
    Else    'The text was not found'
    FileSearch = "Not found" 'tell the user'
End If
Exit Sub
End Sub

Result needed: Row that starts with 12 and 13a split each number value so

12 1707.97152211    142.16     73.54    299.67   1071.52     73.54      0.00      0.0017:01     47.54      0.00      0.00      0.00      0.00      0.00X1      0.00      0.00
13A    0.00    0.00    0.00    0.00   6  26    0.00   1687.69   1729.69   97.35    0.00    0.00   75.63    0.00   0  12  20  26   1687.69

SAFETY INSPECTION 63.00 9
DISPOSAL FEE 65.00 26

If not possible then just put the data into the worksheet and I will use powerquery to handle the rest. I am just having issues grabbing the data from the StoreID and Date to 99 END OF DAY. I need each day by it self based on the sheets cell value.

CodePudding user response：

Please, try the next code:

Sub extractDatafromTextFile()
  Dim sh As Worksheet, txtFileName As String, lastR As Long, i As Long, j As Long
  Dim arrTxt, arrPay1, arrPay2, arrSI, arrDF, SI As Long, val1 As Double
  Const todaysdate2 As String = "101190112421" 'take it from your worksheet
  
  Set sh = 'ThisWorkbook.Worksheets("Sheet1")
  txtFileName = "C:\Users\Fane Branesti\Downloads\FileSample.txt"
  arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(txtFileName, 1).ReadAll, vbCrLf)
  
  For i = 0 To UBound(arrTxt)
      If InStr(arrTxt(i), todaysdate2) > 0 Then
         Do While InStr(arrTxt(i   j), "END OF DAY") = 0
            j = j   1
            If left(arrTxt(i   j), 3) = "12 " Then
                arrPay1 = Split(WorksheetFunction.Trim(arrTxt(i   j)), " ")
            End If
            If left(arrTxt(i   j), 4) = "13A " Then
                arrPay2 = Split(WorksheetFunction.Trim(arrTxt(i   j)), " ")
            End If
            If InStr(arrTxt(i   j), "SAFETY INSPECTION") > 0 Then
                SI = InStr(arrTxt(i   j), "SAFETY INSPECTION")
                arrSI = Split(WorksheetFunction.Trim(left(arrTxt(i   j), SI - 1)), " ")
                val1 = arrSI(1):
                arrSI(0) = "SAFETY INSPECTION": arrSI(1) = arrSI(2): arrSI(2) = val1
            End If
            If InStr(arrTxt(i   j), "DISPOSAL FEE") > 0 Then
                SI = InStr(arrTxt(i   j), "DISPOSAL FEE")
                arrDF = Split(WorksheetFunction.Trim(left(arrTxt(i   j), SI - 1)), " ")
                val1 = arrDF(1):
                arrDF(0) = "DISPOSAL FEE": arrDF(1) = arrDF(2): arrDF(2) = val1
            End If
         Loop
      End If
  Next i
  lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
  sh.Range("A" & lastR   1).Resize(1, UBound(arrPay1)   1).value = arrPay1
  sh.Range("A" & lastR   2).Resize(1, UBound(arrPay2)   1).value = arrPay2
  sh.Range("A" & lastR   3).Resize(1, UBound(arrSI)   1).value = arrSI
  sh.Range("A" & lastR   4).Resize(1, UBound(arrDF)   1).value = arrDF
  MsgBox "Ready..."
End Sub