vba code to convert a series of csv files to a specific header format separately for each csv files

[RAM72]

I have a bunch of csv files per consignment, the files may go up 20 daily .

Actually using excel from csv delimited , rows has headers ,5 rows to leave to reach the headers rows manually

Then to delete duplicate headers and headers that are not applicable for further use.


Rearrange the headers as sample pattern attached in red tab , the yellow headers as per attached sheet are not required firstsheet tab cscconvert

The final result is in red tab with invoice ref which is the first column as its name .

The csv files is found in C:\\ CASS_CSV, there may be be 20 daily ,the amount rows can be to 5000 rows in a csv file but the csv format and headers remains always the same , just data that changes.

Each csv files need to be converted to a specific header pattern which applies for all as per attached, duplicate headers and non relevant headers with their data to be deleted highlighted in yellow.

Looking a code without opening the csv files that will fetch the csv file in c:\\cass_csv , delete non requested headers and rearrange the headers in the pattern as per sample provided.

The xlsx file for each csv file will saved in a folder c:\\ converted_cass.

The yellow headers are a guide which header need to be deleted as but for daily purposes it is plain as I need to this manually.

The header EAN column C need to be formatted actually showing this as below
3.22247E+12

The header as below column H & I to add total with its formatting
Qt‚ fact.
Montant HT

All columns to autofit .

I hope, made my explanations as clear as possible for ease of understanding.

attached one excel file for a better visual explanations

 

[jindon]

Not really sure

Sub test()
    Dim fn, myHeader, x, y, txt As String, myCols, a()
    Dim i As Long, ii As Long, maxCol As Long
    fn = Application.GetOpenFilename("CSVFiles,*.csv")
    If fn = "False" Then Exit Sub
   
    myHeader = Array("Facture", "ligne", "EAN", "Article", "Lib. article", _
               "Pays origine", "Nomenc. douani*", "Qt*", "Prix vente", _
               "Montant HT", "Couleur", "Fabricant", "nom Fabric.", "Rayon", _
               "Lib. rayon", "Degr*", "Contenance", "effectif/pur", "Droits alcool")
               
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
    x = Split(Split(txt, vbNewLine)(4), ";")
    myCols = Application.Match(myHeader, x, 0)
    maxCol = Application.Max(myCols)
    For i = 1 To UBound(myCols)
        myHeader(i - 1) = x(myCols(i) - 1)
    Next
    x = Split(txt, vbNewLine)
    ReDim a(1 To UBound(x), 1 To UBound(myCols))
    For i = 5 To UBound(x)
        y = Split(x(i), ";")
        If UBound(y) >= maxCol - 1 Then
            For ii = 1 To UBound(myCols)
                If UBound(y) >= myCols(ii) - 1 Then
                    a(i - 4, ii) = y(myCols(ii) - 1)
                End If
            Next
        End If
    Next
    With Sheets.Add.Cells(1).Resize(, UBound(a, 2))
        .Value = myHeader
        With .Rows(2).Resize(UBound(a, 1))
            .Value = a
            .Columns(3).NumberFormat = "0"
            .CurrentRegion.Columns.AutoFit
        End With
        .Parent.Name = CreateObject("Scripting.FileSystemObject").GetBaseName(fn)
    End With
End Sub

 

[RAM72]

Not really sure

Sub test()
    Dim fn, myHeader, x, y, txt As String, myCols, a()
    Dim i As Long, ii As Long, maxCol As Long
    fn = Application.GetOpenFilename("CSVFiles,*.csv")
    If fn = "False" Then Exit Sub
 
    myHeader = Array("Facture", "ligne", "EAN", "Article", "Lib. article", _
               "Pays origine", "Nomenc. douani*", "Qt*", "Prix vente", _
               "Montant HT", "Couleur", "Fabricant", "nom Fabric.", "Rayon", _
               "Lib. rayon", "Degr*", "Contenance", "effectif/pur", "Droits alcool")
             
    txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
    x = Split(Split(txt, vbNewLine)(4), ";")
    myCols = Application.Match(myHeader, x, 0)
    maxCol = Application.Max(myCols)
    For i = 1 To UBound(myCols)
        myHeader(i - 1) = x(myCols(i) - 1)
    Next
    x = Split(txt, vbNewLine)
    ReDim a(1 To UBound(x), 1 To UBound(myCols))
    For i = 5 To UBound(x)
        y = Split(x(i), ";")
        If UBound(y) >= maxCol - 1 Then
            For ii = 1 To UBound(myCols)
                If UBound(y) >= myCols(ii) - 1 Then
                    a(i - 4, ii) = y(myCols(ii) - 1)
                End If
            Next
        End If
    Next
    With Sheets.Add.Cells(1).Resize(, UBound(a, 2))
        .Value = myHeader
        With .Rows(2).Resize(UBound(a, 1))
            .Value = a
            .Columns(3).NumberFormat = "0"
            .CurrentRegion.Columns.AutoFit
        End With
        .Parent.Name = CreateObject("Scripting.FileSystemObject").GetBaseName(fn)
    End With
End Sub

Hi Jindon

Your coding worked very very fast on real data.

Thank you a lot the for the time taken you spent

On the right track, tuning on facture header is required as actually it takes the name of the csv file instead of invoice no on facture (yellow)

However could the code take all the csv files in the specified folder without opening the csv files itself .

Actually I do it manually.

 

[jindon]

Sub test()
    Dim myDir As String, fn, myHeader, x, y, txt As String, myCols, a()
    Dim i As Long, ii As Long, maxCol As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then myDir = .SelectedItems(1) & "\"
    End With
    If myDir = vbNullString Then Exit Sub
    fn = Dir(myDir & "*.csv")
    Do While fn <> ""
        myHeader = Array("Facture", "ligne", "EAN", "Article", "Lib. article", _
                   "Pays origine", "Nomenc. douani*", "Qt*", "Prix vente", _
                   "Montant HT", "Couleur", "Fabricant", "nom Fabric.", "Rayon", _
                   "Lib. rayon", "Degr*", "Contenance", "effectif/pur", "Droits alcool")
                   
        txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(myDir & fn).ReadAll
        x = Split(Split(txt, vbNewLine)(4), ";")
        myCols = Application.Match(myHeader, x, 0)
        maxCol = Application.Max(myCols)
        For i = 1 To UBound(myCols)
            myHeader(i - 1) = x(myCols(i) - 1)
        Next
        x = Split(txt, vbNewLine)
        ReDim a(1 To UBound(x), 1 To UBound(myCols))
        For i = 5 To UBound(x)
            y = Split(x(i), ";")
            If UBound(y) >= maxCol - 1 Then
                For ii = 1 To UBound(myCols)
                    If UBound(y) >= myCols(ii) - 1 Then
                        a(i - 4, ii) = y(myCols(ii) - 1)
                    End If
                Next
            End If
        Next
        With Sheets.Add.Cells(1).Resize(, UBound(a, 2))
            .Value = myHeader
            With .Rows(2).Resize(UBound(a, 1))
                .Value = a
                .Columns(3).NumberFormat = "0"
                .CurrentRegion.Columns.AutoFit
            End With
            .Parent.Name = .Parent.[a2].Value
        End With
        fn = Dir
    Loop
End Sub