Need to reset Do while Loop

B

BalloutMoe

Board Regular
Joined
Jun 4, 2021
Messages
137
Office Version
  1. 365
Platform
  1. Windows
Hello all I have a code that reads through a text file,
I would like to reset the Do Loop after this condition is true If InStr(arrTxt(i), todaysdate) > 0, it runs perfect the first time but then it wont find anything on the next run. Any help how can I reset it the Do to the zero

Thank you

VBA Code: 
  Dim fso As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fileopening = fso.OpenTextFile(txtFileName, 1)
arrTxt = Split(fileopening.ReadAll, vbCrLf)
     
  For i = 0 To UBound(arrTxt)
 
      If InStr(arrTxt(i), todaysdate) > 0 Then
      i = i + 2
      If InStr(arrTxt(i), "=MF") Then
                      'If InStr(arrTxt(i + j), "=MF") > 0 Then
        i = i - 1
                        If InStr(arrTxt(i), "ReceiptNumber") > 0 Then
                                InvoiceArray = Split(arrTxt(i), "=")
                                InvoiceNumber = InvoiceArray(1)
                                lastR = ThisWorkbook.Worksheets("Sheet2").Range("B" & Sh.Rows.Count).End(xlUp).Row
                                ThisWorkbook.Worksheets("Sheet2").Range("B" & lastR + 1).Resize(1, 1).Value = InvoiceNumber
                        End If
          i = i + 2
                        If InStr(arrTxt(i), "FirstName=") > 0 Then
                                CompanyArray = Split(arrTxt(i), "=")
                                CompanyName = CompanyArray(1)
                                lastR = ThisWorkbook.Worksheets("Sheet2").Range("C" & Sh.Rows.Count).End(xlUp).Row
                                ThisWorkbook.Worksheets("Sheet2").Range("C" & lastR + 1).Resize(1, 1).Value = CompanyName
                        End If
                        
        'I Need to reset it to 0 before finding the next   If InStr(arrTxt(i), todaysdate) > 0 Then
        Do While InStr(arrTxt(i + j), "[COMMENTS]") = 0
            j = j + 1
                        'LiscPlate
                        If InStr(arrTxt(i + j), "FleetLicn=") > 0 Then
                                PlateArray = Split(arrTxt(i + j), "=")
                                LiscPlate = PlateArray(1)
                                lastR = ThisWorkbook.Worksheets("Sheet2").Range("E" & Sh.Rows.Count).End(xlUp).Row
                                ThisWorkbook.Worksheets("Sheet2").Range("E" & lastR + 1).Resize(1, 1).Value = Trim(LiscPlate)
                        End If

           Loop 
         End If
      End If 'If Instr
  Next i
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
Can you please share a screenshot of the text file? I have a feeling that what you are trying to achieve can be done in a slightly simplified way... Also if there is any confidential information like license plate etc then blur that information before you share the image.
 
Upvote 0
Siddharth Rout said:
Can you please share a screenshot of the text file? I have a feeling that what you are trying to achieve can be done in a slightly simplified way... Also if there is any confidential information like license plate etc then blur that information before you share the image.
Click to expand...
Below is a sample file. I Need to locate RecDateTime then make sure the Mrs = line is "=MF" then get information from there until it reaches this line [COMMENTS] then do it all over again till not RecDateTime from the selected date and no =MF is found. The invoices are stacked above each other in the text file just as shown below but that is one invoice only. It is about a 7 million line file. Thank you

[CUST]
Printer=RECEIPT
RecDateTime=03/25/2022 04:46 PM
ReceiptNumber=131756
Mrs=MF
FirstName=FOR Company Info
Street=PO BOX 6
CustCity=BELLS
CustState=TX
Zip=75414
Licn=PLATEHERE
Vin2Licn=INFO
VIN=VINHERE
Year=2012
Make=FORD
Model=F-150
Engine=V6 3.7L 3726cc 227CID FI (24V) DOHC FLEX VIN:M Eng
PresentMiles=248538
FullServiceMiles=3000
FullServiceMonths=3
NewRep=REP
Total=45.96
SubTotal=44.45
TaxAMT=1.51
SalesTaxPercent=8.25
LneItem=3
Trx=E
Phone=
ServiceTime=13
FluidList= 1. Oil Change.....COMPLETE
FluidList= 2. Oil Filter.....COMPLETE
FluidList= 3. Air Filter.....CHECKED & OK
FluidList= 4. Transmission... FULL
FluidList= 5. Coolant........ FULL
FluidList= 6. Diff/TransAx... FULL
FluidList= 7. PCV Valve......CHECKED & OK
FluidList= 8. Breather.......CHECKED & OK
FluidList= 9. Tire Rotatio...CHECKED & OK
FluidList=10. Brake Fluid....SENSORED
FluidList=11. Chassis Lube...Fittings
FluidList=12. Wiper Blades...CHECKED & OK
FluidList=13. Washer Fluid... FILLED
FluidList=14. BatteryWater... MAIN FREE
FluidList=17. Serp Belts.....OK
FluidList=18. Fuel Filter....CHECKED & OK
FluidList=19. Fuel Injectn...CHECKED & OK
FluidList=20. Cabin Filter...CHECKED & OK
FluidList=21. P.Steer. flu... FULL
ServiceOrderGUID=
FleetAcctNum=51
DriverName=NATHAN
FleetLicn=
FleetAcctVerifiedByKeyFob=False
FleetAcctVerifiedByVIN=False
[COMMENTS]
 
Upvote 0
Info I need is this
RecDateTime make sure its equal to the selected date from the sheet
Mrs=MF this line to contain MF only
FirstName
Vin
Year
Make
Model
Total
FleetLicn

then contain in the file till no other invoices are found.
 
Upvote 0
Ok gimme sometime. I am in the middle of assisting someone. Once I finish that, I will devote time to this. Don't worry, I will help you out with a solution unless someone beats me to it ?
 
Upvote 0
If I have understood what you want, then this may help.

LOGIC:
  1. Open the text file and store it in an array.
  2. Since the data is between [CUST] and [COMMENTS], identify their positions.
  3. Do the relevant Date and MF check between those positions.
  4. If the check succeeds then extract relevant information. The thing in our favor is that the format of the data is consistent. For example. RecDateTime is at 3rd position and MF is at 5th position in that block. Similarly for others. Here is a visual representation
1648581585932.png


CODE:

I have commented the code. If you still have questions then feel free to ask.

VBA Code: 
Option Explicit

'~~> Change this to your file name
Private Const txtFile As String = "C:\Users\routs\Desktop\test.Txt"

Dim strData() As String
Dim rw As Long
Dim ws As Worksheet

Sub Sample()
    Dim MyData As String
   
    '~~> This will add a new worksheet for output
    Set ws = ThisWorkbook.Sheets.Add
   
    '~~> Add headers to new worksheet
    With ws
        .Cells(1, 1).Value = "FirstName"
        .Cells(1, 2).Value = "Vin"
        .Cells(1, 3).Value = "Year"
        .Cells(1, 4).Value = "Make"
        .Cells(1, 5).Value = "Model"
        .Cells(1, 6).Value = "Total"
        .Cells(1, 7).Value = "FleetLicn"
    End With
   
    '~~> This is the 2nd row in the new sheet from where
    '~~> the data will be added
    rw = 2
   
    '~~> Open the text file
    Open txtFile For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)
     
    '~~> Start position and End position variables
    Dim sPos As Long, ePos As Long
    Dim i As Long, j As Long
    Dim todaysdate As String
   
    '~~> I am taking this sample date for testing
    todaysdate = "03/29/2022"
       
    '~~> Loop though the array
    For i = LBound(strData) To UBound(strData)
        '~~> Find [CUST] and then find the following [COMMENTS]
        '~~> This will give use the block between [CUST]...[COMMENTS]
        If InStr(1, strData(i), "[CUST]", vbTextCompare) Then
            sPos = i
           
            For j = sPos To UBound(strData)
                If InStr(1, strData(j), "[COMMENTS]", vbTextCompare) Then
                    ePos = j
                    Exit For
                End If
            Next j
        End If
       
        If ePos <> 0 Then
            '~~> Check if today's date is present in that block
            If InStr(1, strData(sPos + 2), todaysdate) Then
                '~~> Check if MF criteria is also met
                If InStr(1, strData(sPos + 4), "=MF", vbTextCompare) Then
                    '~~> Extract data
                    With ws
                        .Cells(rw, 1).Value = Split(strData(sPos + 5), "=")(1)
                        .Cells(rw, 2).Value = Split(strData(sPos + 12), "=")(1)
                        .Cells(rw, 3).Value = Split(strData(sPos + 13), "=")(1)
                        .Cells(rw, 4).Value = Split(strData(sPos + 14), "=")(1)
                        .Cells(rw, 5).Value = Split(strData(sPos + 15), "=")(1)
                        .Cells(rw, 6).Value = Split(strData(sPos + 21), "=")(1)
                        .Cells(rw, 7).Value = Split(strData(sPos + 51), "=")(1)
                    End With
                    rw = rw + 1
                End If
            End If
            '~~> Set new starting position
            sPos = ePos + 1: ePos = 0
        End If
    Next i
End Sub

OUTPUT:

I obviously created a sample data. Based on that the output is

1648581764490.png


SAMPLE DATA IN TEXT FILE:

[CUST]
Printer=RECEIPT
RecDateTime=03/29/2022 04:46 PM
ReceiptNumber=111
Mrs=MF
FirstName=FOR Company Info
Street=PO BOX 6
CustCity=BELLS
CustState=TX
Zip=75414
Licn=PLATEHERE
Vin2Licn=INFO
VIN=VINHERE
Year=2012
Make=FORD
Model=F-150
Engine=V6 3.7L 3726cc 227CID FI (24V) DOHC FLEX VIN:M Eng
PresentMiles=248538
FullServiceMiles=3000
FullServiceMonths=3
NewRep=REP
Total=45.96
SubTotal=44.45
TaxAMT=1.51
SalesTaxPercent=8.25
LneItem=3
Trx=E
Phone=
ServiceTime=13
FluidList= 1. Oil Change.....COMPLETE
FluidList= 2. Oil Filter.....COMPLETE
FluidList= 3. Air Filter.....CHECKED & OK
FluidList= 4. Transmission... FULL
FluidList= 5. Coolant........ FULL
FluidList= 6. Diff/TransAx... FULL
FluidList= 7. PCV Valve......CHECKED & OK
FluidList= 8. Breather.......CHECKED & OK
FluidList= 9. Tire Rotatio...CHECKED & OK
FluidList=10. Brake Fluid....SENSORED
FluidList=11. Chassis Lube...Fittings
FluidList=12. Wiper Blades...CHECKED & OK
FluidList=13. Washer Fluid... FILLED
FluidList=14. BatteryWater... MAIN FREE
FluidList=17. Serp Belts.....OK
FluidList=18. Fuel Filter....CHECKED & OK
FluidList=19. Fuel Injectn...CHECKED & OK
FluidList=20. Cabin Filter...CHECKED & OK
FluidList=21. P.Steer. flu... FULL
ServiceOrderGUID=
FleetAcctNum=51
DriverName=NATHAN
FleetLicn=
FleetAcctVerifiedByKeyFob=False
FleetAcctVerifiedByVIN=False
[COMMENTS]

[CUST]
Printer=RECEIPT
RecDateTime=03/29/2022 04:46 PM
ReceiptNumber=222
Mrs=MF
FirstName=My Company
Street=PO BOX 6
CustCity=BELLS
CustState=TX
Zip=75414
Licn=PLATEHERE
Vin2Licn=INFO
VIN=MYVIN
Year=2022
Make=BENZ
Model=S CLASS
Engine=V6 3.7L 3726cc 227CID FI (24V) DOHC FLEX VIN:M Eng
PresentMiles=248538
FullServiceMiles=3000
FullServiceMonths=3
NewRep=REP
Total=200
SubTotal=44.45
TaxAMT=1.51
SalesTaxPercent=8.25
LneItem=3
Trx=E
Phone=
ServiceTime=13
FluidList= 1. Oil Change.....COMPLETE
FluidList= 2. Oil Filter.....COMPLETE
FluidList= 3. Air Filter.....CHECKED & OK
FluidList= 4. Transmission... FULL
FluidList= 5. Coolant........ FULL
FluidList= 6. Diff/TransAx... FULL
FluidList= 7. PCV Valve......CHECKED & OK
FluidList= 8. Breather.......CHECKED & OK
FluidList= 9. Tire Rotatio...CHECKED & OK
FluidList=10. Brake Fluid....SENSORED
FluidList=11. Chassis Lube...Fittings
FluidList=12. Wiper Blades...CHECKED & OK
FluidList=13. Washer Fluid... FILLED
FluidList=14. BatteryWater... MAIN FREE
FluidList=17. Serp Belts.....OK
FluidList=18. Fuel Filter....CHECKED & OK
FluidList=19. Fuel Injectn...CHECKED & OK
FluidList=20. Cabin Filter...CHECKED & OK
FluidList=21. P.Steer. flu... FULL
ServiceOrderGUID=
FleetAcctNum=51
DriverName=NATHAN
FleetLicn=NA
FleetAcctVerifiedByKeyFob=False
FleetAcctVerifiedByVIN=False
[COMMENTS]
 
Upvote 0
Siddharth Rout said:
If I have understood what you want, then this may help.

LOGIC:
  1. Open the text file and store it in an array.
  2. Since the data is between [CUST] and [COMMENTS], identify their positions.
  3. Do the relevant Date and MF check between those positions.
  4. If the check succeeds then extract relevant information. The thing in our favor is that the format of the data is consistent. For example. RecDateTime is at 3rd position and MF is at 5th position in that block. Similarly for others. Here is a visual representation
View attachment 61218

CODE:

I have commented the code. If you still have questions then feel free to ask.

VBA Code: 
Option Explicit

'~~> Change this to your file name
Private Const txtFile As String = "C:\Users\routs\Desktop\test.Txt"

Dim strData() As String
Dim rw As Long
Dim ws As Worksheet

Sub Sample()
    Dim MyData As String
  
    '~~> This will add a new worksheet for output
    Set ws = ThisWorkbook.Sheets.Add
  
    '~~> Add headers to new worksheet
    With ws
        .Cells(1, 1).Value = "FirstName"
        .Cells(1, 2).Value = "Vin"
        .Cells(1, 3).Value = "Year"
        .Cells(1, 4).Value = "Make"
        .Cells(1, 5).Value = "Model"
        .Cells(1, 6).Value = "Total"
        .Cells(1, 7).Value = "FleetLicn"
    End With
  
    '~~> This is the 2nd row in the new sheet from where
    '~~> the data will be added
    rw = 2
  
    '~~> Open the text file
    Open txtFile For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)
    
    '~~> Start position and End position variables
    Dim sPos As Long, ePos As Long
    Dim i As Long, j As Long
    Dim todaysdate As String
  
    '~~> I am taking this sample date for testing
    todaysdate = "03/29/2022"
      
    '~~> Loop though the array
    For i = LBound(strData) To UBound(strData)
        '~~> Find [CUST] and then find the following [COMMENTS]
        '~~> This will give use the block between [CUST]...[COMMENTS]
        If InStr(1, strData(i), "[CUST]", vbTextCompare) Then
            sPos = i
          
            For j = sPos To UBound(strData)
                If InStr(1, strData(j), "[COMMENTS]", vbTextCompare) Then
                    ePos = j
                    Exit For
                End If
            Next j
        End If
      
        If ePos <> 0 Then
            '~~> Check if today's date is present in that block
            If InStr(1, strData(sPos + 2), todaysdate) Then
                '~~> Check if MF criteria is also met
                If InStr(1, strData(sPos + 4), "=MF", vbTextCompare) Then
                    '~~> Extract data
                    With ws
                        .Cells(rw, 1).Value = Split(strData(sPos + 5), "=")(1)
                        .Cells(rw, 2).Value = Split(strData(sPos + 12), "=")(1)
                        .Cells(rw, 3).Value = Split(strData(sPos + 13), "=")(1)
                        .Cells(rw, 4).Value = Split(strData(sPos + 14), "=")(1)
                        .Cells(rw, 5).Value = Split(strData(sPos + 15), "=")(1)
                        .Cells(rw, 6).Value = Split(strData(sPos + 21), "=")(1)
                        .Cells(rw, 7).Value = Split(strData(sPos + 51), "=")(1)
                    End With
                    rw = rw + 1
                End If
            End If
            '~~> Set new starting position
            sPos = ePos + 1: ePos = 0
        End If
    Next i
End Sub

OUTPUT:

I obviously created a sample data. Based on that the output is

View attachment 61219

SAMPLE DATA IN TEXT FILE:

[CUST]
Printer=RECEIPT
RecDateTime=03/29/2022 04:46 PM
ReceiptNumber=111
Mrs=MF
FirstName=FOR Company Info
Street=PO BOX 6
CustCity=BELLS
CustState=TX
Zip=75414
Licn=PLATEHERE
Vin2Licn=INFO
VIN=VINHERE
Year=2012
Make=FORD
Model=F-150
Engine=V6 3.7L 3726cc 227CID FI (24V) DOHC FLEX VIN:M Eng
PresentMiles=248538
FullServiceMiles=3000
FullServiceMonths=3
NewRep=REP
Total=45.96
SubTotal=44.45
TaxAMT=1.51
SalesTaxPercent=8.25
LneItem=3
Trx=E
Phone=
ServiceTime=13
FluidList= 1. Oil Change.....COMPLETE
FluidList= 2. Oil Filter.....COMPLETE
FluidList= 3. Air Filter.....CHECKED & OK
FluidList= 4. Transmission... FULL
FluidList= 5. Coolant........ FULL
FluidList= 6. Diff/TransAx... FULL
FluidList= 7. PCV Valve......CHECKED & OK
FluidList= 8. Breather.......CHECKED & OK
FluidList= 9. Tire Rotatio...CHECKED & OK
FluidList=10. Brake Fluid....SENSORED
FluidList=11. Chassis Lube...Fittings
FluidList=12. Wiper Blades...CHECKED & OK
FluidList=13. Washer Fluid... FILLED
FluidList=14. BatteryWater... MAIN FREE
FluidList=17. Serp Belts.....OK
FluidList=18. Fuel Filter....CHECKED & OK
FluidList=19. Fuel Injectn...CHECKED & OK
FluidList=20. Cabin Filter...CHECKED & OK
FluidList=21. P.Steer. flu... FULL
ServiceOrderGUID=
FleetAcctNum=51
DriverName=NATHAN
FleetLicn=
FleetAcctVerifiedByKeyFob=False
FleetAcctVerifiedByVIN=False
[COMMENTS]

[CUST]
Printer=RECEIPT
RecDateTime=03/29/2022 04:46 PM
ReceiptNumber=222
Mrs=MF
FirstName=My Company
Street=PO BOX 6
CustCity=BELLS
CustState=TX
Zip=75414
Licn=PLATEHERE
Vin2Licn=INFO
VIN=MYVIN
Year=2022
Make=BENZ
Model=S CLASS
Engine=V6 3.7L 3726cc 227CID FI (24V) DOHC FLEX VIN:M Eng
PresentMiles=248538
FullServiceMiles=3000
FullServiceMonths=3
NewRep=REP
Total=200
SubTotal=44.45
TaxAMT=1.51
SalesTaxPercent=8.25
LneItem=3
Trx=E
Phone=
ServiceTime=13
FluidList= 1. Oil Change.....COMPLETE
FluidList= 2. Oil Filter.....COMPLETE
FluidList= 3. Air Filter.....CHECKED & OK
FluidList= 4. Transmission... FULL
FluidList= 5. Coolant........ FULL
FluidList= 6. Diff/TransAx... FULL
FluidList= 7. PCV Valve......CHECKED & OK
FluidList= 8. Breather.......CHECKED & OK
FluidList= 9. Tire Rotatio...CHECKED & OK
FluidList=10. Brake Fluid....SENSORED
FluidList=11. Chassis Lube...Fittings
FluidList=12. Wiper Blades...CHECKED & OK
FluidList=13. Washer Fluid... FILLED
FluidList=14. BatteryWater... MAIN FREE
FluidList=17. Serp Belts.....OK
FluidList=18. Fuel Filter....CHECKED & OK
FluidList=19. Fuel Injectn...CHECKED & OK
FluidList=20. Cabin Filter...CHECKED & OK
FluidList=21. P.Steer. flu... FULL
ServiceOrderGUID=
FleetAcctNum=51
DriverName=NATHAN
FleetLicn=NA
FleetAcctVerifiedByKeyFob=False
FleetAcctVerifiedByVIN=False
[COMMENTS]
Click to expand...
the problem with this it is not dynamic, the list is not always the same size between {CUST] and [Comments]
 
Upvote 0
BalloutMoe said:
the problem with this it is not dynamic, the list is not always the same size between {CUST] and [Comments]
Click to expand...

No problem. A small tweak in the above code can handle that. I will post an updated solution later. Perhaps in an hour or so...
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
Text file read and replace values, Large file
Replies
3
Views
503
BalloutMoe
B
B
  • Question
Array error handling if array is missing or empty
Replies
1
Views
2K
Candyman8019
C
B
  • Solved
Reading Text file and splitting dynamic sized string into array help
2 3 4
Replies
33
Views
3K
BSALV
BSALV
B
  • Solved
Do Until loop nested in For loop, How advance to the "Next x" in the For Loop
Replies
4
Views
265
CephasOz
CephasOz
H
  • Solved
Amend the VBA code to Filter Columns Instead of Rows
Replies
9
Views
170
Akuini
Akuini

Forum statistics

Threads
1,215,202
Messages
6,123,625
Members
449,109
Latest member
Sebas8956

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top