Reading Text file and splitting dynamic sized string into array help

BalloutMoe

Board Regular
Joined
Jun 4, 2021
Messages
137
Office Version
  1. 365
Platform
  1. Windows
Hello all I have the following in a text file that is being read by vba and going line by line

60ANDREW COX 0.00A08:00 09:58 ANDREW COX
60DAVID BEAUMONT 0.00A08:08 13:26 14:09 18:00 D. BEAUMONT
60JOSEPG CAMACHO 0.00A08:04 11:10 11:41 18:01 JO CAMACHO
60JUAN CABRERA 0.00A08:00 18:02 JUAN CABRERA
60ROBERT ELMORE 0.00A08:04 18:02 ROBERT ELMOR
60RUBEN CABRERA 0.00A15:00 18:02 RUBEN CABRER
60TRISTON HILL 0.00A08:02 11:52 12:27 18:02 TRISTON HILL
60JOSE VARGAS 0.00A08:19 16:22 16:54 18:01 VARGAS
99 END OF DAY

I would like to split the strings for example
David Beamount08:0813:26
David Beamount14:0918:00
Josepg Camacho08:0411:10
Josepg Camacho11:4118:01

and So on for each employee. Sometime the row can have a bunch of different time clocks. Each two represent a clock in and clock out. How can I split it dynamically and enter it into a sheet? I have the following code below it works but only first the first clock and clock out. Thank you for your help

VBA Code:
  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
            
            For t = 2 To 17
                                   If InStr(arrTxt(i + j), "60" & ThisWorkbook.Worksheets("Times").Range("K" & t) & " " & ThisWorkbook.Worksheets("Times").Range("L" & t)) > 0 Then  'Safety Inspection
                                    'SI = InStr(arrTxt(i + j), "60ANDREW ")
                                    arrTime = Split(WorksheetFunction.Trim(arrTxt(i + j)), " ")
                                    
                                    arrTime(0) = Right(arrTime(0), Len(arrTime(0)) - 2) & " " & arrTime(1)
                                    arrTime(2) = Split(arrTime(2), "A")(1)
                                    
                                            If arrTime(2) <= "08:10" Then
                                            arrTime(2) = "08:00"
                                            End If
                                     
                                            If arrTime(3) >= "17:53" And arrTime(3) <= "18:25" Then
                                            arrTime(3) = "18:00"
                                            End If
                          
                
                                            lastR2 = ThisWorkbook.Worksheets("Times").Range("A" & Sh.Rows.Count).End(xlUp).Row
                                            On Error Resume Next
                                            ThisWorkbook.Worksheets("Times").Range("A" & lastR2 + 1).Resize(1, 1).Value = arrTime(0)
                                            ThisWorkbook.Worksheets("Times").Range("B" & lastR2 + 1).Resize(1, 1).Value = arrTime(2)
                                            ThisWorkbook.Worksheets("Times").Range("C" & lastR2 + 1).Resize(1, 1).Value = arrTime(3)
                                            ThisWorkbook.Worksheets("Times").Range("D" & lastR2 + 1).Resize(1, 1).Value = todaysdate
                                            
                                  
                                   End If
                 Next
                                
         Loop 'For Do

      End If 'If Instr
  Next i
 
VBA Code:
Sub splitten()
     Dim Result(), t_IN, t_OUT

     a = Sheets("blad3").Range("a1").CurrentRegion.Value        'read your data to an array (or another method to get those data into an array)
     ReDim Result(1 To UBound(a) * 3, 1 To 4)                   'prepare result array with (precaution) 3 timeslots per employee

     For i = 1 To UBound(a)                                     'loop through the data

          If InStr(1, a(i, 1), "TERRELLL WHO", vbTextCompare) > 0 Then     'line with your date-string
               s = Right(Split(a(i, 1))(0), 8)                  '1st word, 8 last characters
               mydate = DateSerial(Right(s, 4), Mid(s, 3, 2), Left(s, 2))     'make a date of it
         
          ElseIf InStr(1, a(i, 1), "end of day", vbTextCompare) > 0 Then
               mydate = 0                                       'reset your date after "end of day"

          ElseIf Len(a(i, 1)) - Len(Replace(a(i, 1), ":", "")) >= 2 Then     'there are at least 2 ":"-characters in that record

               sp = Split(a(i, 1), "0.00A")                     'split on this string
               If UBound(sp) = 1 Then                           'there are 2 parts
                    sp1 = Split(sp(1))                          'split the 2nd part on the spaces
                    For j = 0 To UBound(sp1) Step 2             'loop through the times (per 2, in and out)
                         If InStr(sp1(j), ":") = 0 Then Exit For     'if there is no ":" in that part, then it is no longer a time, so quit
                         ptr = ptr + 1                          'increment pointer
                         Result(ptr, 1) = WorksheetFunction.Proper(Mid(sp(0), 3))     'Name

                         t_IN = TimeValue(sp1(j))               'actual in
                         If t_IN <= TimeValue("08:10") Then t_IN = TimeValue("08:00")     'manipulate in
                         Result(ptr, 2) = t_IN                  'add to array

                         t_OUT = TimeValue(sp1(j + 1))          'actual out
                         If WorksheetFunction.Median(TimeValue("17:53"), TimeValue("18:25"), t_OUT) = t_OUT Then t_OUT = TimeValue("18:00")     'manipulate out
                         Result(ptr, 3) = t_OUT                 'add to array
                         Result(ptr, 4) = CDbl(mydate)
                    Next
               End If
          End If
     Next

     if ptr > 0 then ThisWorkbook.Worksheets("Times").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(ptr, 4).Value = Result

End Sub
 
Upvote 0

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
VBA Code:
Sub splitten()
     Dim Result(), t_IN, t_OUT

     a = Sheets("blad3").Range("a1").CurrentRegion.Value        'read your data to an array (or another method to get those data into an array)
     ReDim Result(1 To UBound(a) * 3, 1 To 4)                   'prepare result array with (precaution) 3 timeslots per employee

     For i = 1 To UBound(a)                                     'loop through the data

          If InStr(1, a(i, 1), "TERRELLL WHO", vbTextCompare) > 0 Then     'line with your date-string
               s = Right(Split(a(i, 1))(0), 8)                  '1st word, 8 last characters
               mydate = DateSerial(Right(s, 4), Mid(s, 3, 2), Left(s, 2))     'make a date of it
        
          ElseIf InStr(1, a(i, 1), "end of day", vbTextCompare) > 0 Then
               mydate = 0                                       'reset your date after "end of day"

          ElseIf Len(a(i, 1)) - Len(Replace(a(i, 1), ":", "")) >= 2 Then     'there are at least 2 ":"-characters in that record

               sp = Split(a(i, 1), "0.00A")                     'split on this string
               If UBound(sp) = 1 Then                           'there are 2 parts
                    sp1 = Split(sp(1))                          'split the 2nd part on the spaces
                    For j = 0 To UBound(sp1) Step 2             'loop through the times (per 2, in and out)
                         If InStr(sp1(j), ":") = 0 Then Exit For     'if there is no ":" in that part, then it is no longer a time, so quit
                         ptr = ptr + 1                          'increment pointer
                         Result(ptr, 1) = WorksheetFunction.Proper(Mid(sp(0), 3))     'Name

                         t_IN = TimeValue(sp1(j))               'actual in
                         If t_IN <= TimeValue("08:10") Then t_IN = TimeValue("08:00")     'manipulate in
                         Result(ptr, 2) = t_IN                  'add to array

                         t_OUT = TimeValue(sp1(j + 1))          'actual out
                         If WorksheetFunction.Median(TimeValue("17:53"), TimeValue("18:25"), t_OUT) = t_OUT Then t_OUT = TimeValue("18:00")     'manipulate out
                         Result(ptr, 3) = t_OUT                 'add to array
                         Result(ptr, 4) = CDbl(mydate)
                    Next
               End If
          End If
     Next

     if ptr > 0 then ThisWorkbook.Worksheets("Times").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(ptr, 4).Value = Result

End Sub
a = Sheets("blad3").Range("a1").CurrentRegion.Value 'read your data to an array (or another method to get those data into an array)
this line? My data is in a text file not on a sheet and its a large file
 
Upvote 0
Here is the link for a sample file Meet Google Drive – One place for all your files
from the first line to 99 END OF DAY is a whole data for a day. 99 END OF DAY being the last line for the day. I would like to match the store code (100001) and date (021522) they are always the first line combine they look like this (100001021522) from there I would like to extract the times for that day for each employee. On a sheet for the user I would like to choose a date and get the employee time clocks for that individual day
 
Upvote 0
Just looking for a link to a sample text file that you use. that doesn't require a password or anything.
 
Upvote 0
VBA Code:
Sub splitten()
     Dim Result(), t_IN, t_OUT

     a = Sheets("blad3").Range("a1").CurrentRegion.Value        'read your data to an array (or another method to get those data into an array)
     ReDim Result(1 To UBound(a) * 3, 1 To 4)                   'prepare result array with (precaution) 3 timeslots per employee

     For i = 1 To UBound(a)                                     'loop through the data

          If InStr(1, a(i, 1), "TERRELLL WHO", vbTextCompare) > 0 Then     'line with your date-string
               s = Right(Split(a(i, 1))(0), 8)                  '1st word, 8 last characters
               mydate = DateSerial(Right(s, 4), Mid(s, 3, 2), Left(s, 2))     'make a date of it
        
          ElseIf InStr(1, a(i, 1), "end of day", vbTextCompare) > 0 Then
               mydate = 0                                       'reset your date after "end of day"

          ElseIf Len(a(i, 1)) - Len(Replace(a(i, 1), ":", "")) >= 2 Then     'there are at least 2 ":"-characters in that record

               sp = Split(a(i, 1), "0.00A")                     'split on this string
               If UBound(sp) = 1 Then                           'there are 2 parts
                    sp1 = Split(sp(1))                          'split the 2nd part on the spaces
                    For j = 0 To UBound(sp1) Step 2             'loop through the times (per 2, in and out)
                         If InStr(sp1(j), ":") = 0 Then Exit For     'if there is no ":" in that part, then it is no longer a time, so quit
                         ptr = ptr + 1                          'increment pointer
                         Result(ptr, 1) = WorksheetFunction.Proper(Mid(sp(0), 3))     'Name

                         t_IN = TimeValue(sp1(j))               'actual in
                         If t_IN <= TimeValue("08:10") Then t_IN = TimeValue("08:00")     'manipulate in
                         Result(ptr, 2) = t_IN                  'add to array

                         t_OUT = TimeValue(sp1(j + 1))          'actual out
                         If WorksheetFunction.Median(TimeValue("17:53"), TimeValue("18:25"), t_OUT) = t_OUT Then t_OUT = TimeValue("18:00")     'manipulate out
                         Result(ptr, 3) = t_OUT                 'add to array
                         Result(ptr, 4) = CDbl(mydate)
                    Next
               End If
          End If
     Next

     if ptr > 0 then ThisWorkbook.Worksheets("Times").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(ptr, 4).Value = Result

End Sub
I would like to be able to choose a date which is on a sheet and match that day. I have data dating back to 09 on the text file. So it needs to be by date and not Terrell who
 
Upvote 0
answer in a hour, but is not very complicated, first other job.
 
Upvote 0
G1 and G2 are now the 2 cells for your store and your date, but you can change that
VBA Code:
Sub splitten()
     Dim Result(), t_IN, t_OUT, bOkay

     '************************
     'choose, open and read textfile*
     '************************
     With Application.FileDialog(msoFileDialogFilePicker)       'open dialog for choosing the right textfile
          .AllowMultiSelect = False
          .Title = UCase("Choose your logfile")
          With .Filters
               .Clear
               .Add "Text Files (*.txt)", "*.txt"
          End With

          If Not .Show() Then
               Exit Sub                                         'nothing choosen
          Else
               sfileName = .SelectedItems(1)                    'the textfile you choose

               fileNo = FreeFile                                'Get first free file number
               Open sfileName For Input As #fileNo              'open textfile
               a = Split(Input$(LOF(fileNo), fileNo), vbLf)     'read content and split on vblf
               Close #fileNo                                    'close textfile
     'Sheets("blad1").Range("A1").Resize(UBound(a) + 1).Value = Application.Transpose(a)'write to a sheet somewhere
          End If
     End With

     '*************
     'manipulate data
     '*************
     ReDim Result(1 To UBound(a) * 3, 1 To 4)                   'prepare result array with (precaution) 3 timeslots per employee

     With ThisWorkbook.Worksheets("Times")
          my_store = .Range("G1").Value                         'choose your store in G1
          mydate = .Range("G2").Value                           'choose your date in G2
          my_date = Format(mydate, "mmddyy")                    'your date in the right format

          For i = 0 To UBound(a)                                'loop through the data
               If a(i) Like my_store & my_date & " *" Then      'startline of your right store and date
                    bOkay = True                                'flag up
                    s = Right(Split(a(i))(0), 6)                '1st word, 8 last characters
                    mydate = DateSerial(Right(s, 2), Left(s, 2), Mid(s, 3, 2))     'make a date of it

               ElseIf InStr(1, a(i), "end of day", vbTextCompare) > 0 Then     'check eind of day
                    bOkay = False                               'flag down
                    mydate = 0                                  'reset your date after "end of day"

               ElseIf Len(a(i)) - Len(Replace(a(i), ":", "")) >= 2 And bOkay Then     'there are at least 2 ":"-characters in that record

                    sp = Split(a(i), "0.00A")                   'split on this string
                    If UBound(sp) = 1 Then                      'there are 2 parts
                         sp1 = Split(sp(1))                     'split the 2nd part on the spaces
                         For j = 0 To UBound(sp1) Step 2        'loop through the times (per 2, in and out)
                              If InStr(sp1(j), ":") = 0 Then Exit For     'if there is no ":" in that part, then it is no longer a time, so quit
                              ptr = ptr + 1                     'increment pointer
                              Result(ptr, 1) = WorksheetFunction.Proper(Mid(sp(0), 3))     'Name

                              t_IN = TimeValue(sp1(j))          'actual in
                              If t_IN <= TimeValue("08:10") Then t_IN = TimeValue("08:00")     'manipulate in
                              Result(ptr, 2) = t_IN             'add to array

                              t_OUT = TimeValue(sp1(j + 1))     'actual out
                              If WorksheetFunction.Median(TimeValue("17:53"), TimeValue("18:25"), t_OUT) = t_OUT Then t_OUT = TimeValue("18:00")     'manipulate out
                              Result(ptr, 3) = t_OUT            'add to array
                              Result(ptr, 4) = CDbl(mydate)
                         Next
                    End If
               End If
          Next

          If ptr > 0 Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(ptr, 4).Value = Result     'write to output
          MsgBox IIf(ptr = 0, "nothing found", ptr & " lines added"), vbInformation     'msgbox

     End With

End Sub
 
Upvote 0
Solution
G1 and G2 are now the 2 cells for your store and your date, but you can change that
VBA Code:
Sub splitten()
     Dim Result(), t_IN, t_OUT, bOkay

     '************************
     'choose, open and read textfile*
     '************************
     With Application.FileDialog(msoFileDialogFilePicker)       'open dialog for choosing the right textfile
          .AllowMultiSelect = False
          .Title = UCase("Choose your logfile")
          With .Filters
               .Clear
               .Add "Text Files (*.txt)", "*.txt"
          End With

          If Not .Show() Then
               Exit Sub                                         'nothing choosen
          Else
               sfileName = .SelectedItems(1)                    'the textfile you choose

               fileNo = FreeFile                                'Get first free file number
               Open sfileName For Input As #fileNo              'open textfile
               a = Split(Input$(LOF(fileNo), fileNo), vbLf)     'read content and split on vblf
               Close #fileNo                                    'close textfile
     'Sheets("blad1").Range("A1").Resize(UBound(a) + 1).Value = Application.Transpose(a)'write to a sheet somewhere
          End If
     End With

     '*************
     'manipulate data
     '*************
     ReDim Result(1 To UBound(a) * 3, 1 To 4)                   'prepare result array with (precaution) 3 timeslots per employee

     With ThisWorkbook.Worksheets("Times")
          my_store = .Range("G1").Value                         'choose your store in G1
          mydate = .Range("G2").Value                           'choose your date in G2
          my_date = Format(mydate, "mmddyy")                    'your date in the right format

          For i = 0 To UBound(a)                                'loop through the data
               If a(i) Like my_store & my_date & " *" Then      'startline of your right store and date
                    bOkay = True                                'flag up
                    s = Right(Split(a(i))(0), 6)                '1st word, 8 last characters
                    mydate = DateSerial(Right(s, 2), Left(s, 2), Mid(s, 3, 2))     'make a date of it

               ElseIf InStr(1, a(i), "end of day", vbTextCompare) > 0 Then     'check eind of day
                    bOkay = False                               'flag down
                    mydate = 0                                  'reset your date after "end of day"

               ElseIf Len(a(i)) - Len(Replace(a(i), ":", "")) >= 2 And bOkay Then     'there are at least 2 ":"-characters in that record

                    sp = Split(a(i), "0.00A")                   'split on this string
                    If UBound(sp) = 1 Then                      'there are 2 parts
                         sp1 = Split(sp(1))                     'split the 2nd part on the spaces
                         For j = 0 To UBound(sp1) Step 2        'loop through the times (per 2, in and out)
                              If InStr(sp1(j), ":") = 0 Then Exit For     'if there is no ":" in that part, then it is no longer a time, so quit
                              ptr = ptr + 1                     'increment pointer
                              Result(ptr, 1) = WorksheetFunction.Proper(Mid(sp(0), 3))     'Name

                              t_IN = TimeValue(sp1(j))          'actual in
                              If t_IN <= TimeValue("08:10") Then t_IN = TimeValue("08:00")     'manipulate in
                              Result(ptr, 2) = t_IN             'add to array

                              t_OUT = TimeValue(sp1(j + 1))     'actual out
                              If WorksheetFunction.Median(TimeValue("17:53"), TimeValue("18:25"), t_OUT) = t_OUT Then t_OUT = TimeValue("18:00")     'manipulate out
                              Result(ptr, 3) = t_OUT            'add to array
                              Result(ptr, 4) = CDbl(mydate)
                         Next
                    End If
               End If
          Next

          If ptr > 0 Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(ptr, 4).Value = Result     'write to output
          MsgBox IIf(ptr = 0, "nothing found", ptr & " lines added"), vbInformation     'msgbox

     End With

End Sub
Thank you so much this worked perfectly. Just curious how can I replace this line
If ptr > 0 Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(ptr, 4).Value = Result 'write to output
MsgBox IIf(ptr = 0, "nothing found", ptr & " lines added"), vbInformation 'msgbox

instead of a range to put it into an existing table and resize it
 
Upvote 0
Also one o
G1 and G2 are now the 2 cells for your store and your date, but you can change that
VBA Code:
Sub splitten()
     Dim Result(), t_IN, t_OUT, bOkay

     '************************
     'choose, open and read textfile*
     '************************
     With Application.FileDialog(msoFileDialogFilePicker)       'open dialog for choosing the right textfile
          .AllowMultiSelect = False
          .Title = UCase("Choose your logfile")
          With .Filters
               .Clear
               .Add "Text Files (*.txt)", "*.txt"
          End With

          If Not .Show() Then
               Exit Sub                                         'nothing choosen
          Else
               sfileName = .SelectedItems(1)                    'the textfile you choose

               fileNo = FreeFile                                'Get first free file number
               Open sfileName For Input As #fileNo              'open textfile
               a = Split(Input$(LOF(fileNo), fileNo), vbLf)     'read content and split on vblf
               Close #fileNo                                    'close textfile
     'Sheets("blad1").Range("A1").Resize(UBound(a) + 1).Value = Application.Transpose(a)'write to a sheet somewhere
          End If
     End With

     '*************
     'manipulate data
     '*************
     ReDim Result(1 To UBound(a) * 3, 1 To 4)                   'prepare result array with (precaution) 3 timeslots per employee

     With ThisWorkbook.Worksheets("Times")
          my_store = .Range("G1").Value                         'choose your store in G1
          mydate = .Range("G2").Value                           'choose your date in G2
          my_date = Format(mydate, "mmddyy")                    'your date in the right format

          For i = 0 To UBound(a)                                'loop through the data
               If a(i) Like my_store & my_date & " *" Then      'startline of your right store and date
                    bOkay = True                                'flag up
                    s = Right(Split(a(i))(0), 6)                '1st word, 8 last characters
                    mydate = DateSerial(Right(s, 2), Left(s, 2), Mid(s, 3, 2))     'make a date of it

               ElseIf InStr(1, a(i), "end of day", vbTextCompare) > 0 Then     'check eind of day
                    bOkay = False                               'flag down
                    mydate = 0                                  'reset your date after "end of day"

               ElseIf Len(a(i)) - Len(Replace(a(i), ":", "")) >= 2 And bOkay Then     'there are at least 2 ":"-characters in that record

                    sp = Split(a(i), "0.00A")                   'split on this string
                    If UBound(sp) = 1 Then                      'there are 2 parts
                         sp1 = Split(sp(1))                     'split the 2nd part on the spaces
                         For j = 0 To UBound(sp1) Step 2        'loop through the times (per 2, in and out)
                              If InStr(sp1(j), ":") = 0 Then Exit For     'if there is no ":" in that part, then it is no longer a time, so quit
                              ptr = ptr + 1                     'increment pointer
                              Result(ptr, 1) = WorksheetFunction.Proper(Mid(sp(0), 3))     'Name

                              t_IN = TimeValue(sp1(j))          'actual in
                              If t_IN <= TimeValue("08:10") Then t_IN = TimeValue("08:00")     'manipulate in
                              Result(ptr, 2) = t_IN             'add to array

                              t_OUT = TimeValue(sp1(j + 1))     'actual out
                              If WorksheetFunction.Median(TimeValue("17:53"), TimeValue("18:25"), t_OUT) = t_OUT Then t_OUT = TimeValue("18:00")     'manipulate out
                              Result(ptr, 3) = t_OUT            'add to array
                              Result(ptr, 4) = CDbl(mydate)
                         Next
                    End If
               End If
          Next

          If ptr > 0 Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(ptr, 4).Value = Result     'write to output
          MsgBox IIf(ptr = 0, "nothing found", ptr & " lines added"), vbInformation     'msgbox

     End With

End Sub
Also one of the names Jason Guerrero is coming out like this "Jason Guerrero 1"
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

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