Vfrdtyky

I am completely new to VBA, but I have CSV files(same format for all of them), and I want to import them to a single sheet on Excel. I was able to read the CSV file according to this code:

Sub R_AnalysisMerger()

Dim WSA As Worksheet

Dim bookList As Workbook

Dim SelectedFiles() As Variant

Dim NFile As Long

Dim FileName As String

Dim ws As Worksheet, vDB As Variant, rngT As Range



Application.ScreenUpdating = False



'Selects the CSV files as SELECTED FILES

Set ws = ThisWorkbook.Sheets(1)

ws.UsedRange.Clear  'Clears current worksheet

SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.csv*), *.csv*", MultiSelect:=True) 'Selects csv files





For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)

    FileName = SelectedFiles(NFile)

    Set bookList = Workbooks.Open(FileName, Format:=2)

    Set WSA = bookList.Sheets(1)

    With WSA

        vDB = .UsedRange

        Set rngT = ws.Range("a" & Rows.count).End(xlUp)(2)

        If rngT.Row = 2 Then Set rngT = ws.Range("A1")

        rngT.Resize(UBound(vDB, 1), UBound(vDB, 2)) = vDB



        bookList.Close (0)

    End With

Next

Application.ScreenUpdating = True

ws.Range("A1").Select

But I have additional requirements:
Skip the first column.
Skip the first four rows.
Remove a certain String from each word in the fifth row.

Im used to java, and usually I would read each line with a "for" loop and set "if" statements to skip the first row and four columns and remove the string from each string if it was present.

I don't know how to do this with this code. From what I understand it just copies the whole CSV file into the sheet?

This solution is based on reading CSV as textstream. I have tried to include feature that makes possible most all things like selecting columns, Rows and so on.

Sub ImportCSV()    



Dim fso As New IWshRuntimeLibrary.FileSystemObject

Dim txtStream  As IWshRuntimeLibrary.TextStream

Dim files As IWshRuntimeLibrary.files

Dim file As IWshRuntimeLibrary.file

Dim txtLine As String

Dim lineCount As Integer

Dim lastRow As Integer

Dim lineCol As Variant

Dim rng As Range



Application.ScreenUpdating = False

ThisWorkbook.Sheets(1).usedRange.Delete

Set rng = ThisWorkbook.Sheets(1).usedRange

lastRow = 1

Set files = fso.GetFolder("pathfolder").files



For Each file In files

    If file.Name Like "*.csv" Then

        Set txtStream = file.OpenAsTextStream(ForReading, TristateUseDefault)

        txtStream.SkipLine                                 ' skip first line, since it containes headers

        lineCount = 1

        Do

            txtLine = txtStream.ReadLine

            If lineCount = 5 Then

                txtLine = Replace(txtLine, "stringToReplace", "StringToReplcaeWith")    ' replace certain string from words in 5'th row

            End If

            lineCount = lineCount + 1

            lineCol = sliceStr(Split(txtLine, ";"), startIdx:=4)        ' slice the array so to skip four first columns

            For iCol = 0 To UBound(lineCol)                             ' write columns to last row

                rng(lastRow, iCol + 1).Value = lineCol(iCol)

            Next iCol

            lastRow = lastRow + 1

            'Debug.Print Join(lineCol, ";")                              ' debug

        Loop Until txtStream.AtEndOfStream

    End If

Next file

Application.ScreenUpdating = True

End Sub

This is the slicer function

Function sliceStr(arr As Variant, startIdx As Integer, Optional stopIdx As Integer = 0) As String()

        If stopIdx = 0 Then

           stopIdx = UBound(arr)

        End If

        Dim tempArrStr() As String

        ReDim tempArrStr(stopIdx - startIdx)

        Dim counter As Integer

        counter = 0

        For i = startIdx To stopIdx

            tempArrStr(counter) = arr(i)

            counter = counter + 1

        Next

        sliceStr = tempArrStr

End Function

I just did a simple test and the code below seems to work. Give it a go, and feedback.

Sub Demo()

     Dim fso As Object 'FileSystemObject

     Dim fldStart As Object 'Folder

     Dim fld As Object 'Folder

     Dim fl As Object 'File

     Dim Mask As String



Application.ScreenUpdating = False

 Dim newWS As Worksheet



Set newWS = Sheets.Add(before:=Sheets(1))



    Set fso = CreateObject("scripting.FileSystemObject") ' late binding

     'Set fso = New FileSystemObject 'or use early binding (also replace Object types)



    Set fldStart = fso.GetFolder("C:UsersryansOneDriveDesktopoutput") ' <-- use your FileDialog code here

     Mask = "*.csv"

     'Debug.Print fldStart.Path & ""

     ListFiles fldStart, Mask

     For Each fld In fldStart.SubFolders

         ListFiles fld, Mask

         ListFolders fld, Mask

     Next



Dim myWB As Workbook, WB As Workbook

 Set myWB = ThisWorkbook

 Dim L As Long, t As Long, i As Long

 L = myWB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row

 t = 1

 For i = 1 To L

 Workbooks.OpenText Filename:=myWB.Sheets(1).Cells(i, 1).Value, DataType:=xlDelimited, Tab:=True

 Set WB = ActiveWorkbook

 lrow = WB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row

 WB.Sheets(1).Range("B4:E" & lrow).Copy newWS.Cells(t, 2)

 t = myWB.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row + 1

 WB.Close False

 Next

 myWB.Sheets(1).Columns(1).Delete

 Application.ScreenUpdating = True

 End Sub







Sub ListFolders(fldStart As Object, Mask As String)

     Dim fld As Object 'Folder

     For Each fld In fldStart.SubFolders

         'Debug.Print fld.Path & ""

         ListFiles fld, Mask

         ListFolders fld, Mask

     Next

 End Sub







Sub ListFiles(fld As Object, Mask As String)

 Dim t As Long

     Dim fl As Object 'File

     For Each fl In fld.Files

         If fl.Name Like Mask Then

         t = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1

             'Debug.Print fld.Path & "" & fl.Name

             If Sheets(1).Cells(1, 1) = "" Then

             Sheets(1).Cells(1, 1) = fld.Path & "" & fl.Name

             Else

             Sheets(1).Cells(t, 1) = fld.Path & "" & fl.Name

             End If

         End If

     Next

 End Sub