Extract certain data from text file

[TheWennerWoman]

Hello, I have some backgammon files I'd like to extract the dice rolls from. The files are in an .sgf format (but they open in Notepad++ as readable text files).

Line 1 of each file is a config row so I want to ignore it. But from line 2 onwards, these contain the dice rolls. The lines are always in this format

;B[62agac]A[2][agln E ver 3 0.507860 0.131387 0.005938 0.135761 0.005711 0.015720 2C 0 1 0.000000 1]
;W[31hefe]A[1][fchg E ver 3 0.501876 0.146071 0.005506 0.135889 0.008282 0.003752 2C 0 1 0.000000 1]

The dice rolls are stored at position 4 and 5 of each line - so in line one, black rolled a 6 and a 2, in line two white rolled a 3 and a 1.

Can I loop through a folder full of these files and extract the rolls into a worksheet, columns A and B being the two dice rolled by black, columns C and D those by white?

Many thanks for reading.

 

[James006]

Hi,
You could have a look at following solution :

Import Data from Text Using Power Query or Get & Transform | MyExcelOnline

Import Data from Text Using Power Query/Get & Transform - Use this in Power Query or Get & Transform to import data from a text file...

www.myexcelonline.com

 

[TheWennerWoman]

Hi,
You could have a look at following solution :

Import Data from Text Using Power Query or Get & Transform | MyExcelOnline

Import Data from Text Using Power Query/Get & Transform - Use this in Power Query or Get & Transform to import data from a text file...

www.myexcelonline.com

Hi, I was looking for a VBA solution rather than having to manually manipulate each file, there are dozens if not hundred os them.

 

[Skyybot]

What file sharing service do you use? Could you share one of the .sgf files?

 

[TheWennerWoman]

What file sharing service do you use? Could you share one of the .sgf files?

Here

is one

 

[Skyybot]

Would you like for it to happen automatically on Workbook Open? Or would you prefer a Macro that you can execute when wanted?

 

[Skyybot]

Here is a Macro that you can execute whenever you want.

Option Base 1
Sub backgammon()
Dim bacfile As String, bacbk As Workbook, bacsht As Worksheet, datarng As Range, cell As Range, i As Long, x As Long
Dim wd1 As Integer, wd2 As Integer, bd1 As Integer, bd2 As Integer
Dim wht(), blk(), pstrng As Range
Application.ScreenUpdating = False
bacfile = Application.GetOpenFilename
Set bacbk = Workbooks.Open(Filename:=bacfile, Delimiter:=4)
Set bacsht = bacbk.Worksheets(1): bacsht.Rows(1).Delete
Set datarng = bacsht.Range(Cells(1, 1), Cells(bacsht.UsedRange.Rows.Count, 1))
w = 0: b = 0
For Each cell In datarng
    If Mid(cell.Value, 2, 1) = "W" Then
        w = w + 1
    ElseIf Mid(cell.Value, 2, 1) = "B" Then
        b = b + 1
    End If
Next cell
ReDim wht(w, 2): ReDim blk(b, 2)
w = 0: b = 0
For Each cell In datarng
    If Mid(cell.Value, 2, 1) = "W" Then
        w = w + 1
        wd1 = Mid(cell.Value, 4, 1)
        wd2 = Mid(cell.Value, 5, 1)
        wht(w, 1) = wd1
        wht(w, 2) = wd2
    ElseIf Mid(cell.Value, 2, 1) = "B" Then
        b = b + 1
        bd1 = Mid(cell.Value, 4, 1)
        bd2 = Mid(cell.Value, 5, 1)
        blk(b, 1) = bd1
        blk(b, 2) = bd2
    End If
Next cell
Set pstrng = bacsht.Range(Cells(2, 1), Cells(w + 1, 4))
bacsht.Cells.ClearContents
With bacsht.Range(Cells(1, 1), Cells(1, 2))
    .Merge
    .HorizontalAlignment = xlCenter
End With
With bacsht.Range(Cells(1, 3), Cells(1, 4))
    .Merge
    .HorizontalAlignment = xlCenter
End With
bacsht.Cells(1, 1) = "Black": bacsht.Cells(1, 3) = "White"
For i = 1 To pstrng.Rows.Count
    pstrng.Cells(i, 1) = blk(i, 1): pstrng.Cells(i, 2) = blk(i, 2)
    pstrng.Cells(i, 3) = wht(i, 1): pstrng.Cells(i, 4) = wht(i, 2)
Next i
Application.ScreenUpdating = True
End Sub

 

[TheWennerWoman]

Works a treat, many thanks for taking the time to assist.

 

[Skyybot]

Works a treat, many thanks for taking the time to assist.

Np. Happy to help.