Macro to Copy a Specific Column Values From Different csv Files into a Single Worksheet

Ay Sticky

New Member
Joined
Oct 18, 2021
Messages
37
Office Version
  1. 2016
Platform
  1. Windows
Good day experts, I need to fetch values from an identified column (DistanceToNext), across numerous csv files into a single worksheet. These csv files are indexed with numbers. The first csv file indexed 001 is to be pasted in first column of the single worksheet. The second csv indexed 002 to be pasted in second column of the single sheet and so on. All files with samples can be obtained in the link below, including a text file describing the whole task because the tasks seems more than what I have explained here.

 
A VBA demonstration for starters :​
VBA Code:
Sub Demo1()
    Dim P$, C$, L&, V(), F%, K&, N&, S$(), R&
        P = ThisWorkbook.Path & "\GbonagunNodeMeasurements\"
        C = Dir$(P & "*.csv"):  If C = "" Then Beep: Exit Sub
        While C > "":  L = L + 1:  C = Dir$:  Wend
        ReDim V(1 To L + 1, 1 To L + 1)
        V(L + 1, L + 1) = 0
   With Application
       .StatusBar = "       Processing " & L & " csv files …"
        F = FreeFile
        C = Dir$(P & "*.csv")
    Do
        K = 0
        N = N + 1
        V(N, N) = 0
        Open P & C For Input As #F
        S = Split(Input(LOF(F), #F), vbLf)
        Close #F
    For R = 4 To .Min(.Match("""#*", S, 0) - 5, 3 + L * 2) Step 2
        K = K + 1
        V(K + N, N) = Round(Val(Split(Split(S(R), ",")(4), """")(1)), 2)
        V(N, K + N) = V(K + N, N)
    Next
        L = L - 1
        C = Dir$:  If N Mod 300 = 0 Then DoEvents
    Loop Until C = ""
       .SheetsInNewWorkbook = 1
       .StatusBar = False
        Workbooks.Add.Sheets(1).[A1].Resize(N + 1, N + 1).Value2 = V
       .DisplayAlerts = False
        ActiveWorkbook.SaveAs P & "CSV Import ", 51
       .DisplayAlerts = True
   End With
End Sub
After running the code, all I heard is the normal warning beeping sound. No changes, no error highlighted, no display of anything new, nothing nothing.
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
As it works a treat on my side just see the codeline where the statement Beep is in order to understand your issue :​
you just forgot to update the path within the code … Should I remind « Coding can't be guessing ! »​
All the csv source files are in the folder "GbonagunNodeMeasurements"
The better explanation & attachment, the better code !​
 
Upvote 0
A VBA demonstration for starters :​
VBA Code:
Sub Demo1()
    Dim P$, C$, L&, V(), F%, K&, N&, S$(), R&
        P = ThisWorkbook.Path & "\GbonagunNodeMeasurements\"
        C = Dir$(P & "*.csv"):  If C = "" Then Beep: Exit Sub
        While C > "":  L = L + 1:  C = Dir$:  Wend
        ReDim V(1 To L + 1, 1 To L + 1)
        V(L + 1, L + 1) = 0
   With Application
       .StatusBar = "       Processing " & L & " csv files …"
        F = FreeFile
        C = Dir$(P & "*.csv")
    Do
        K = 0
        N = N + 1
        V(N, N) = 0
        Open P & C For Input As #F
        S = Split(Input(LOF(F), #F), vbLf)
        Close #F
    For R = 4 To .Min(.Match("""#*", S, 0) - 5, 3 + L * 2) Step 2
        K = K + 1
        V(K + N, N) = Round(Val(Split(Split(S(R), ",")(4), """")(1)), 2)
        V(N, K + N) = V(K + N, N)
    Next
        L = L - 1
        C = Dir$:  If N Mod 300 = 0 Then DoEvents
    Loop Until C = ""
       .SheetsInNewWorkbook = 1
       .StatusBar = False
        Workbooks.Add.Sheets(1).[A1].Resize(N + 1, N + 1).Value2 = V
       .DisplayAlerts = False
        ActiveWorkbook.SaveAs P & "CSV Import ", 51
       .DisplayAlerts = True
   End With
End Sub
Superb! It worked perfectly!! This code did the job as accurate as no other!

All those tasks in a single code? I give you the accolades! The beauty of it all is that it could even be applied to another set of csv text files with different row numbers different from the ones I uploaded. This is pure professionalism. Thank you.
 
Upvote 0
As it works a treat on my side just see the codeline where the statement Beep is in order to understand your issue :​
you just forgot to update the path within the code … Should I remind « Coding can't be guessing ! »​

The better explanation & attachment, the better code !​
As you said, I got the file path wrong. It worked swiftly after adjusting to the appropriate file path.... Still looks like day dream to me. The manual process could have cost me months. Thank you once again. I guess you are the owner of this platform, looking from your high knowledge in vba coding and the patience you possess in helping people solve their excel problems.
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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