Summ in txt file

[sal21]

0001, Napoli, 66, 5678
0001, Napoli, 22, 478
0001, Napoli, 16, 7
0002, Roma, 6, 8
0002, Roma, 11, 8890
Eccc.

This is the structure of a txt file

I need to summ the last 2 item, until the id change.(0001, 0002.,.)

To the and
0001, Napoli, 44, 6163
Ecc...

I just have a code to read line by line the txt file

Note:
The row are just order by id, 0001,0002, 0034,0067, ecc

[HansV]

What is your current code?

[sal21]

Dim FileNum As Integer
Dim DataLine As String

FileNum = FreeFile()
Open "Filename" For Input As #FileNum

While Not EOF(FileNum)
Line Input #FileNum, DataLine

Wend
Close #FileNum

Very, very simple

[robertocm]

Try this (assuming last characters in files are vbCrLf)
(updated: fixed)

Code: Select all

Sub test()
On Error GoTo ExceptionHandling
'Application.ScreenUpdating = False

Dim sFilePath As String, strtxt As String
Dim Str_0 As String, Str_1 As String, StrAnt_0 As String, StrAnt_1 As String, Val_2 As Long, Val_3 As Long, ValAnt_2 As Long, ValAnt_3 As Long, Sum_2 As Long, Sum_3 As Long, i As Integer
Dim tmpLoc As Integer
Dim OutAr(1 To 1000, 1 To 4) As Variant
Dim ArrStr() As String, ArrStr_0() As String
Dim myCount As Integer
sFilePath = ActiveWorkbook.Path & "\test.txt"

Dim FSO As Object
Dim fil As Object
Dim Txt As Object
'File System Object can read only ASCII or Unicode text files
Set FSO = CreateObject("Scripting.FileSystemObject")
'El archivo que nos gustaría abrir y leer
Set fil = FSO.GetFile(sFilePath)
'Abrir archivo como TextStream
Set Txt = fil.OpenAsTextStream(1)
'Leer el archivo incluido en una variable de cadena de una vez
strtxt = Txt.ReadAll
'Cerrar textstream y liberar el archivo. Ya no lo necesitamos más
Txt.Close
Set FSO = Nothing

'Another option
'Set a reference to Microsoft ActiveX Data Objects (ADO)
'Dim objStream
'Set objStream = CreateObject("ADODB.Stream")
'objStream.Charset = "iso-8859-1"
'objStream.Open
'objStream.LoadFromFile (sFilePath)
'strtxt = objStream.ReadText()

tmpLoc = InStr(1, strtxt, vbCrLf)
Do Until tmpLoc = 0
    ArrStr = Split(Left(strtxt, tmpLoc - 1), ", ")
    'Debug.Print ArrStr(0) & ", " & ArrStr(1) & ", " & ArrStr(2) & ", " & ArrStr(3)
    strtxt = Right(strtxt, Len(strtxt) - tmpLoc - 1)
    tmpLoc = InStr(1, strtxt, vbCrLf)
    Str_0 = ArrStr(0)
    Str_1 = ArrStr(1)
    Val_2 = CLng(ArrStr(2))
    Val_3 = CLng(ArrStr(3))
    If StrAnt_0 = "" Then StrAnt_0 = Str_0

'Debug.Print StrAnt_0 & vbTab & Str_0
    If Not StrAnt_0 = Str_0 Then
        myCount = myCount + 1
        OutAr(myCount, 1) = StrAnt_0
        OutAr(myCount, 2) = StrAnt_1
        OutAr(myCount, 3) = Sum + ValAnt_2
        OutAr(myCount, 4) = Sum_2 + ValAnt_3
        Sum = 0
        Sum_2 = 0
    ElseIf tmpLoc = 0 Then
        myCount = myCount + 1
        OutAr(myCount, 1) = StrAnt_0
        OutAr(myCount, 2) = StrAnt_1
        OutAr(myCount, 3) = Sum + Val_2 + ValAnt_2
        OutAr(myCount, 4) = Sum_2 + Val_3 + ValAnt_3
    Else
        Sum = Sum + Val_2
        Sum_2 = Sum_2 + Val_3
    End If

    StrAnt_0 = Str_0
    StrAnt_1 = Str_1
    ValAnt_2 = Val_2
    ValAnt_3 = Val_3
Loop

For i = 1 To myCount
    Debug.Print OutAr(i, 1) & ", " & OutAr(i, 2) & ", " & OutAr(i, 3) & ", " & OutAr(i, 4)
Next i

CleanUp:
    'Application.ScreenUpdating = True
    On Error Resume Next
    Exit Sub
ExceptionHandling:
    MsgBox "Error: " & Err.Description
    Resume CleanUp
    Resume 'for debugging, https://stackoverflow.com/a/52206311
End Sub

[HansV]

At the beginning of the code:

Code: Select all

    Dim Parts() as String
    Dim PrevID as string
    Dim ID as String
    Dim lngSum1 As Long
    Dim lngSum2 As Long

Below the line

Code: Select all

        Line Input #FileNum, DataLine

insert:

Code: Select all

    Parts = Split(DataLine, ", ")
        ID = DataLine(0)
        If ID <> PrevID And PrevID <> "" Then
            Debug.Print PrevID, lngSum1, lngSum2
            lngSum1 = 0
            lngSum2 = 0
        End If
        PrevID = ID
        lngSum1 = lngSum1 + Val(Parts(2)
        lngSum2 = lngSum2 + Val(Parts(3)

At the end of the code:

Code: Select all

    Debug.Print PrevID, lngSum1, lngSum2

[sal21]

At the beginning of the code:

Code: Select all

    Dim Parts() as String
    Dim PrevID as string
    Dim ID as String
    Dim lngSum1 As Long
    Dim lngSum2 As Long

Below the line

Code: Select all

        Line Input #FileNum, DataLine

insert:

Code: Select all

    Parts = Split(DataLine, ", ")
        ID = DataLine(0)
        If ID <> PrevID And PrevID <> "" Then
            Debug.Print PrevID, lngSum1, lngSum2
            lngSum1 = 0
            lngSum2 = 0
        End If
        PrevID = ID
        lngSum1 = lngSum1 + Val(Parts(2)
        lngSum2 = lngSum2 + Val(Parts(3)

At the end of the code:

Code: Select all

    Debug.Print PrevID, lngSum1, lngSum2

SORRY, bro
but in test the line input dont work, because in the file have to set .Charset = "utf-8".

my new code(Hans docet!)

Code: Select all

Public Sub UTF8_HANS()
    
    Dim STEXT As String, I As Long, ALINES() As String, VALORE As String
    Dim MASCHI As Long, FEMMINE As Long, TOTALE As Long, ISTAT As String
    
    With New ADODB.Stream
        .Type = adTypeText
        .Charset = "utf-8"
        .Open
        .LoadFromFile "C:\Lavori_Vb6\LEGGI_CSV_COMUNI\FILES\POSAS_2023_it_Tutti_i_file\POSAS_2023_it_001_Torino.csv" 'STRPATHFILE & NOMEFILE
        STEXT = .ReadText(adReadAll)
        .Close
        ALINES = Split(STEXT, vbLf)
    End With
    
    For I = 2 To UBound(ALINES) - 2
        ISTAT = Split(ALINES(I), ";")(0)
        MASCHI = Split(ALINES(I), ";")(3)
        FEMMINE = Split(ALINES(I), ";")(4)
        TOTALE = Split(ALINES(I), ";")(5)
    Next I
    
End Sub

attached original file

Iin oter case, in original txt, the total of MASCHI and FEMMINE jus have to the last item of row

note:
in the original file i skip the first two row, and the last row, not important for my project

[SpeakEasy]

Or you could try

Code: Select all

Sub Example()

    directory = "D:\Downloads\DeleteMe"
    Filename = "TableSal21.txt"
    
    Set rs = CreateObject("ADODB.Recordset")
    strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & directory & ";" & "Extended Properties=""text;HDR=No;FMT=Delimited"";"
    strSQL = "SELECT F1, F2, F3, F4 FROM " & Filename
    strSQL = "SELECT format(F1,'000#'), F2 , Sum(F3) AS SumOfno1, Sum(F4) AS SumOfno2 FROM " & Filename & " GROUP BY F1, F2"
    rs.Open strSQL, strcon, 3, 3
    Debug.Print rs.GetString(, , ", ")

End Sub

[sal21]

Or you could try

Code: Select all

Sub Example()

    directory = "D:\Downloads\DeleteMe"
    Filename = "TableSal21.txt"
    
    Set rs = CreateObject("ADODB.Recordset")
    strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & directory & ";" & "Extended Properties=""text;HDR=No;FMT=Delimited"";"
    strSQL = "SELECT F1, F2, F3, F4 FROM " & Filename
    strSQL = "SELECT format(F1,'000#'), F2 , Sum(F3) AS SumOfno1, Sum(F4) AS SumOfno2 FROM " & Filename & " GROUP BY F1, F2"
    rs.Open strSQL, strcon, 3, 3
    Debug.Print rs.GetString(, , ", ")

End Sub

HI BRO, attached, in the last post of Hans, the original file

[SpeakEasy]

So, just to be clear here: your actual requirement is not as outlined in your original post.

• You don't want the last two items of 4, you want items 4 and 5 from 6 items

• It isn't an actual CSV, as there are at least 2 rows with only a single item (admittedly you didn't state this was a CSV file in the original post, although it was implied - and your example file is has a CSV extension ...)

• The separators are not commas but semicolons

So probably a little much to expect any of the solutions initially proposed here to actually work ...

Anyway, here's an update of my solution that meets your current requirements (as long as you remove the first line of the file)

Code: Select all

Sub testDatabase2()

    directory = "D:\Downloads\DeleteMe"
    filename = "POSAS_2023_it_001_Torino.csv"
    
    '  Create a temp schema.ini to override builtin text ISAM defaults
    Open directory & "\schema.ini" For Output As #1 ' must be in same folder as the csv
    Print #1, "[POSAS_2023_it_001_Torino.csv]"
    Print #1, "Format=Delimited(;)"
    Close #1
    
    Set rs = CreateObject("ADODB.Recordset")
    strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & directory & ";" & "Extended Properties=""text;HDR=YES;FMT=Delimited"";"
    strSQL = "SELECT [Codice comune], Comune , Sum([Totale maschi]) AS SumOfno1, Sum([Totale femmine]) AS SumOfno2 FROM " & filename & " GROUP BY [Codice comune], Comune"
    rs.Open strSQL, strcon, 3, 3
    
    Debug.Print rs.GetString(, , ", ") ' kill temp schema.ini
    ' Alternatively
    'Dim results As Variant
    'results = rs.GetRows()
    
    Kill directory & "\schema.ini"
End Sub

[sal21]

So, just to be clear here: your actual requirement is not as outlined in your original post.

• You don't want the last two items of 4, you want items 4 and 5 from 6 items

• It isn't an actual CSV, as there are at least 2 rows with only a single item (admittedly you didn't state this was a CSV file in the original post, although it was implied - and your example file is has a CSV extension ...)

• The separators are not commas but semicolons

So probably a little much to expect any of the solutions initially proposed here to actually work ...

Anyway, here's an update of my solution that meets your current requirements (as long as you remove the first line of the file)

Code: Select all

Sub testDatabase2()

    directory = "D:\Downloads\DeleteMe"
    filename = "POSAS_2023_it_001_Torino.csv"
    
    '  Create a temp schema.ini to override builtin text ISAM defaults
    Open directory & "\schema.ini" For Output As #1 ' must be in same folder as the csv
    Print #1, "[POSAS_2023_it_001_Torino.csv]"
    Print #1, "Format=Delimited(;)"
    Close #1
    
    Set rs = CreateObject("ADODB.Recordset")
    strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & directory & ";" & "Extended Properties=""text;HDR=YES;FMT=Delimited"";"
    strSQL = "SELECT [Codice comune], Comune , Sum([Totale maschi]) AS SumOfno1, Sum([Totale femmine]) AS SumOfno2 FROM " & filename & " GROUP BY [Codice comune], Comune"
    rs.Open strSQL, strcon, 3, 3
    
    Debug.Print rs.GetString(, , ", ") ' kill temp schema.ini
    ' Alternatively
    'Dim results As Variant
    'results = rs.GetRows()
    
    Kill directory & "\schema.ini"
End Sub

HAVE error in: RS.Open strSQL, strcon, 3, 3

note:
have you tested?

[SpeakEasy]

Did I test? yes. Did you read my post in full?

>as long as you remove the first line of the file

[sal21]

Did I test? yes. Did you read my post in full?

>as long as you remove the first line of the file

HAAAAA....
Sorry me, read with attention, NOW WORK!.

but only a prob, i need to read 108 txt file, from dir with the same structure!!!

possible to delete the first line via code?

[snb]

Are you serious ?
Adapt the path "G:\OF\"

Code: Select all

Sub M_snb()
  MsgBox Join(Filter(Split(CreateObject("scripting.filesystemobject").opentextfile("G:\OF\POSAS_2023_it_001_Torino.csv").readall, vbCrLf), ";999;"), vbLf)
End Sub

[sal21]

Are you serious ?
Adapt the path "G:\OF\"

Code: Select all

Sub M_snb()
  MsgBox Join(Filter(Split(CreateObject("scripting.filesystemobject").opentextfile("G:\OF\POSAS_2023_it_001_Torino.csv").readall, vbCrLf), ";999;"), vbLf)
End Sub

work! i see in msgbox the file have not the first line!
but i need to overwrite the source file with the same name, in dir?

[sal21]

Did I test? yes. Did you read my post in full?

>as long as you remove the first line of the file

HAAAAA....
Sorry me, read with attention, NOW WORK!.

but only a prob, i need to read 108 txt file, from dir with the same structure!!!

possible to delete the first line via code?

In other case i have found a big file that contain all value of the 108 files, without the first line!
But i think have a prob... instead a ; have comm ,

[snb]

@sal

Please, start with an analysis, think in Italian, write in Italian, translate in DeepL, post in E-lounge.
Don't turn this into a salami-thread.

[SpeakEasy]

>But i think have a prob... instead a ; have comm ,

!!!

So, the example file you gave us, POSAS_2023_it_001_Torino.csv, is NOT an actual example of the files you are dealing with?

In which case simply removing the schema.ini code from my last example will address this (or editing it to set the separator to a comma - but since this is the default, removal is the easiest option and simplifies the code slightly)

[sal21]

So, just to be clear here: your actual requirement is not as outlined in your original post.

• You don't want the last two items of 4, you want items 4 and 5 from 6 items

• It isn't an actual CSV, as there are at least 2 rows with only a single item (admittedly you didn't state this was a CSV file in the original post, although it was implied - and your example file is has a CSV extension ...)

• The separators are not commas but semicolons

So probably a little much to expect any of the solutions initially proposed here to actually work ...

Anyway, here's an update of my solution that meets your current requirements (as long as you remove the first line of the file)

Code: Select all

Sub testDatabase2()

    directory = "D:\Downloads\DeleteMe"
    filename = "POSAS_2023_it_001_Torino.csv"
    
    '  Create a temp schema.ini to override builtin text ISAM defaults
    Open directory & "\schema.ini" For Output As #1 ' must be in same folder as the csv
    Print #1, "[POSAS_2023_it_001_Torino.csv]"
    Print #1, "Format=Delimited(;)"
    Close #1
    
    Set rs = CreateObject("ADODB.Recordset")
    strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & directory & ";" & "Extended Properties=""text;HDR=YES;FMT=Delimited"";"
    strSQL = "SELECT [Codice comune], Comune , Sum([Totale maschi]) AS SumOfno1, Sum([Totale femmine]) AS SumOfno2 FROM " & filename & " GROUP BY [Codice comune], Comune"
    rs.Open strSQL, strcon, 3, 3
    
    Debug.Print rs.GetString(, , ", ") ' kill temp schema.ini
    ' Alternatively
    'Dim results As Variant
    'results = rs.GetRows()
    
    Kill directory & "\schema.ini"
End Sub

I BRO.
Possible to make a where clausole on field [età]=999, in the your query?
???

[HansV]

See SQL GROUP BY Statement for the syntax of a SQL statement with GROUP BY and a WHERE clause.

[SpeakEasy]

>Possible to make a where clausole on field [età]=999, in the your query?

That question made me look harder at your data files. And now I see the file ALREADY contains the totals you asked us to calculate: In the rows where field [Età]=999.

So you don't need a calculation at all. Indeed, the calculation would have produced results that are DOUIBE the actual answer you want since we are adding the calculated total to the total already given in the file.

You just need to select those rows without doing any calculation whatsoever. <sigh>

So you'd theoretically neeed something like

Code: Select all

strSQL = "SELECT [Codice comune], Comune , [Totale maschi] , [Totale femmine] FROM " & filename & " WHERE [Età] = 999"

However, this won't quite work as expected. See if you can figure out why.