Consolidating different worksheets into a main excel worksheet - excel

I am really new to VBA and I have just been learning the basics and the VBA language recently from Youtube and communities such as these. Therefore, any help will be really appreciated!
I am trying to consolidate excel worksheets from different excel workbooks into a main excel workbook. The excel workbooks are all found in the same file. However, they are named differently and I only have the partial names for the excel workbooks e.g. "ABG_RSPB_xxxxx-yyyy".
I will have a main workbook in the folder consolidating the data from all the different workbook and worksheets. Each workbook where the data is extracted from only has one worksheet and the template in each worksheet is the same. They have the same headers as well. All the workbooks are csv format. However the worksheets have partial names as well (the worksheet will have the same name as the workbook it is in).
Currently, I have a macro that provides a similar function however, it can't extract workbooks and worksheets with partial names.
Any help to amend the macro such that it can extract from partial workbooks and worksheets will be deeply appreciated. Thank you!
Current code:
Sub consolidation ()
Set mainWB = ActiveWorkbook
Dim mainPath As String
mainPath = ThisWorkbook.Path
Dim mainRowstart As Integer
mainRowstart = 2
Dim mainRC As Integer
mainRC = lastRow ("Consolidated Trades", "A") + 1
If mainRC < mainRowStart Then
mainRC = mainRowStart
EndIf
Dim fso As Object
Dim folder As Object
Dim files As Object
Set fso = CreateObject ("Scripting.FileSystemObject")
Set folderPaths = fso.getfolder (mainPath)
set filePaths = folderPath.files
Dim curFile As String
Dim curPath As String
Dim curRC As Integer
Dim curWSName As String
curWSName = ""
For Each filePath In filePaths
curPath = filePath
curFile = Split (curPath, "\")(UBound(Split(curPath, "\")))
If Left (curFile, 1) <> "~" Then
If curFile <> "ABG_RSPB_xxxxx=yyy.csv" Then
If Right (curFile, Len ("ABG_RSPB_xxxxx=yyy.xlsm")) = "ABG_RSPB_xxxxx=yyy.xlsm" Or _ Right (curFile, Len("ABG_RSPB_xxxxx=yyy.xls")) = "ABG_RSPB_xxxxx=yyy.xls" Then
Workbooks.Open Filename: = curPath
Workbooks (curFile).Activate
For Each ws In Worksheets
If ws.Name = "ABG_RSPB_xxxxx=yyy.csv" Then
curWSName = ws.Name
End If
Next Ws
curRC = lastRow(CurWSName, "A")
mainWB.Activate
mainRC = lastrow("Consolidated Trades", "A") + 1
If curRC >= 2 Then
mainWB.Worksheets("Consolidated Trades").Range("A" & mainRC & ":U: & mainRC + curRC - 2).Value = _ Workbooks(curFile).Worksheets(curWSName).Range("A2:U" & curRC).Value
mainWB.Worksheets("Consolidated Trades").Range("V" & mainRC).Value = curFile & "with" & curRC -1 & "Rows of Data"
EndIf
Workbooks(curFile).Close
EndIf
EndIf
EndIf
NextfilePath
MsgBox "Process Complete"
End Sub

If I've understood you correctly, you have some csv files besides your main workbook and you want to iterate over all csv files and read all values in the first column of the first sheet of each file and then write them into the first column of the main workbook, right?
I've assumed that:
all csv files are desired and should be read (i.e., there is no csv file that you do not want to read it)
You have a subroutine called "lastrow" that finds the last row in a column of a sheet
Please see if the following code does the job correctly. If there is any problem, please leave a comment below, I'll see and edit my code as you want.
Sub consolidation()
Dim mainRowstart As Integer
mainRowstart = 2
Dim mainRC As Integer
mainRC = lastrow("Consolidated Trades", "A") + 1 'I've assumed that you have another sub called "lastrow"
If mainRC < mainRowstart Then
mainRC = mainRowstart
End If
'======================================================================================================
' 1- Get all csv files in this workbook's path
'======================================================================================================
Dim allCsvFiles() As Variant
allCsvFiles = GetFileList(ThisWorkbook.path, "csv")
'======================================================================================================
' 2- Loop over and read/write all data
'======================================================================================================
If IsArray(allCsvFiles) Then 'i.e., at least one file has found
Dim file As Variant
For Each file In allCsvFiles
'Open file
Workbooks.Open (file)
'Activate
Workbooks(file).Activate
'How many rows do exist in the file?
Dim curRC As Integer
curRC = lastrow(Workbooks(file).Sheets(1).Name, "A") 'Hint: as the file is a "csv" file, it always contains only one sheet and there is no need to search and find a specific sheet
If curRC > 2 Then
mainRC = lastrow("Consolidated Trades", "A") + 1 'Is it required to run this function in every iteration???
ThisWorkbook.Worksheets("Consolidated Trades").Range("V" & mainRC).Value = file & " with " & curRC - 1 & " rows of data"
'Read and write data
Dim row As Integer
For row = 2 To curRC
ThisWorkbook.Worksheets("Consolidated Trades").Cells(mainRC, 1).Value = Workbooks(file).Sheets(1).Cells(row, 1).Value
mainRC = mainRC + 1
Next row
End If
'Close file
Workbooks(file).Close False
Next
MsgBox "Process Complete"
End If
End Sub
where GetFileList is:
Function GetFileList(path As String, FileSpec As String) As Variant
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
FileCount = 0
FileName = Dir(path & "\*." & FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
NoFilesFound:
GetFileList = False
End Function

Related

Transfer data from .csv files to a workbook

I'm trying to code a Macro in Excel that:
Goes through hundreds of .csv files.
Get their names and put them in the first row of the target workbook.
Copy columns E & R from each .csv file and paste them below their corresponding name in the target workbook.
Example: in the target workbook, I should get, the title_1 (of csv_1) in cell A1, then data from columns E & R of csv_1 pasted in cells A2 & B2. Column C empty. Then title_2 (of csv_2) in cell D1, respective columns E & R pasted in D2 & E2. Column F empty and so on...
I would like the data to be organize like this
Attempt:
Sub LoopExcels ()
Dim directory As String
Dim fileName As String
Dim i As Integer
Dim j As Integer
Dim wb As Workbook
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim wsTarget As Worksheet
Dim ColOutputTarget As Long
ColOutputTarget = 1
Set wsTarget = Sheets("Sheet1")
Application.ScreenUpdating = FALSE
Application.DisplayAlerts = FALSE
directory = "C:\data"
fileName = Dir(directory & "*.csv")
Do Until fileName = ""
Set wbSource = Workbooks.Open(directory & fileName)
Set wsSource = wbSource.Worksheets(1)
j = j + 1
i = 1
Cells(i, 1) = fileName
Workbooks.Open (directory & fileName)
For Each sheet In Workbooks(fileName).Worksheets 'my excels contain only one sheet but didn't know how to get rid of the "For each sheet"
wsTarget.Cells(i, j).Value = sheet.Name
j = j + 2
Next sheet
With wsTarget
.Range("A" & ColOutputTarget).Value = wsSource.Range("E1:E100").Value 'Need to copy all data in columns it can be 10 cells and it doesn't exceed 100 cells
.Range("B" & ColOutputTarget).Value = wsSource.Range("R1:R100").Value
ColOutputTarget = ColOutputTarget + 1
End With
wbSource.Close SaveChanges:=False
fileName = Dir()
Loop
Application.CutCopyMode = FALSE
End Sub
I've been looking for a solution with no luck.
I found a way to loop through files
I managed partially to get the names of each file (I found a code that goes thru all sheets in an Excel file. My files contain only one sheet so maybe it can be simplified)
And for some reason it doesn't copy the full name. some files have LONG names +50 characters.
I am having issues with copy/pasting the columns. Each column has data from 10 to 100 cells.
The code below, go thru the files but paste the data in the same column. I end up getting only the data from the last excel file it opens which get pasted in the first 2 columns.
I can't find a way to make it shift to the next column every time its done with each csv file.
For order to work:
you need to place the Excel file (that has the macro) inside the folder of the .CSV files.
create 2 sheets in the main Excel file with the names "file names" and "target sheet". You can change this in the code if you want.
if you are using Windows just insert the path of the folder containing the .csv files.
if you are using mac insert the path of the folder containing the .csv files and change all the "\" in the macro to "/".
Sub Awesome()
getNames
positionTitles
transferData
End Sub
Sub getNames()
Dim sFilePath As String
Dim sFileName As String
Dim counter As Long
counter = 1
'Specify folder Path for the .csv files
sFilePath = "c:\"
'Check for back slash
If Right(sFilePath, 1) <> "\" Then
sFilePath = sFilePath & "\"
End If
sFileName = Dir(sFilePath & "*.csv")
Do While Len(sFileName) > 0
If Right(sFileName, 3) = "csv" Then
'Display file name in immediate window
Sheets("file names").Cells(counter, 1) = sFileName
counter = counter + 1
End If
'Set the fileName to the next available file
sFileName = Dir
Loop
End Sub
Sub positionTitles()
Dim counter As Long
Dim used_range As Range
Dim col As Long
col = 1
Set used_range = Sheets("file names").UsedRange
For counter = 1 To used_range.Rows.Count
Sheets("target sheet").Cells(1, col) = Sheets("file names").Cells(counter, 1)
col = col + 4
Next counter
End Sub
Sub transferData()
'turn off unnecessary applications
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim file_name As String
Dim counter As Long
Dim used_range As Range
Dim main_wb As Workbook
Dim col As Long
Dim key As Boolean
Dim last_row As Long
Dim second_key As Boolean
col = 1
Set main_wb = ThisWorkbook
Set used_range = Sheets("file names").UsedRange
For counter = 1 To used_range.Rows.Count
file_name = main_wb.Sheets("file names").Cells(counter, 1)
Workbooks.Open ActiveWorkbook.Path & "\" & file_name, Local:=True
'transfer data to target_sheet
For col = col To 1000
If key = False Then
last_row = ActiveWorkbook.ActiveSheet.Range("E" & Rows.Count).End(xlUp).Row
ActiveWorkbook.ActiveSheet.Range("E1:E" & last_row).Copy
main_wb.Sheets("target sheet").Cells(2, col).PasteSpecial
key = True
ElseIf second_key = False Then
last_row = ActiveWorkbook.ActiveSheet.Range("R" & Rows.Count).End(xlUp).Row
ActiveWorkbook.ActiveSheet.Range("R1:R" & last_row).Copy
main_wb.Sheets("target sheet").Cells(2, col).PasteSpecial
second_key = True
Else
last_row = ActiveWorkbook.ActiveSheet.Range("K" & Rows.Count).End(xlUp).Row
ActiveWorkbook.ActiveSheet.Range("K1:K" & last_row).Copy
main_wb.Sheets("target sheet").Cells(2, col).PasteSpecial
col = col + 2
Exit For
End If
Next col
key = False
second_key = False
Workbooks(file_name).Close savechanges:=False
Next counter
'turn on applications
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.DisplayAlerts = True
End Sub

Excel CSV Formatting Macro

I am trying to export multiple worksheets as an specific csv file with very specific formatting to feed into third party software (PJe Calc Cidadão).
PJe accepts files written in the following format:
"MES_ANO";"VALOR";"FGTS";"FGTS_REC.";"CONTRIBUICAO_SOCIAL";"CONTRIBUICAO_SOCIAL_REC."
"10/2012";"500,00";"S";"S";"S";"S"
"01/2013";"500,00";"S";"N";"S";"N"
I can achieve this formatting by concatenating formatted values in a single column of a worksheet and saving it as a CSV, but once I open the CSV outside excel it is formated as:
"""MES_ANO"";""VALOR"";""FGTS"";""FGTS_REC."";""CONTRIBUICAO_SOCIAL"";""CONTRIBUICAO_SOCIAL_REC."""
"""12/2015"";""1000,00"";""N"";""N"";""N"";""N"""
"""01/2016"";""1000,00"";""N"";""N"";""N"";""N"""
If I simply copy and paste the column in a txt file I can get the format that I want, but since I need to do that multiple times it's a bit tiring
Any advice?
Assuming you want to export Columns A to F on all the sheets in the workbook to separate csv files with unicode encoding then try this ;
Option Explicit
Sub exportcsv()
Const LAST_COL = 6
Const DELIM = ";"
Const QUOTE = """"
Dim wb As Workbook, ws As Worksheet
Dim iRow As Long, iLastRow As Long, s As String, c As Integer, count As Integer
Dim oFSO As Object, oFS As Object
Dim sPath As String, sCSVfile As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set wb = ThisWorkbook
sPath = wb.path & "\"
For Each ws In wb.Sheets
count = 0
sCSVfile = "Sheet_" & ws.Index & ".csv"
Set oFS = oFSO.CreateTextFile(sPath & sCSVfile, True, True) 'overwrite, Unicode
iLastRow = ws.Cells(Rows.count, 1).End(xlUp).Row
For iRow = 1 To iLastRow
s = ""
For c = 1 To LAST_COL
If c > 1 Then s = s & DELIM
s = s & QUOTE & ws.Cells(iRow, c) & QUOTE
Next
oFS.writeline s
count = count + 1
Next
oFS.Close
Debug.Print sCSVfile, count
Next
MsgBox "CSV files exported to " & sPath, vbInformation, "Finished"
End Sub

"Operation Search and Merge": VBA

I've been trying to scavange together a macro which will merge several .CSV files.
However, the data I need in said file (GPS data) is located in different rows of column A. I therefor need it to search for part of a string, in this case there are a few strings related to GPS, but I only need GPS latitud and longitude (which will always be found one after another).
Any help is appreciated! The code might look a bit.. like shit, ive been trying to mess with it to make it work together!
Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim directory As Object
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range
Dim S_Lat, S_Long, D_Lat, D_Long As Range
Dim i As Integer
Dim icount As Integer
Dim icount2 As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then '-1 = yes or true
FolderPath = .SelectedItems(1) & "\"
Else
MsgBox "FilePath not selected!", , "Path selecter"
Exit Sub
End If
End With
' Create a new workbook and set a variable to the first sheet.
Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 2
' Call Dir the first time, pointing it to all .csv files in the folder path.
FileName = dir(FolderPath & "*.csv")
SummarySheet.Range("A1") = "Filnamn"
SummarySheet.Range("B1") = "Latitud"
SummarySheet.Range("C1") = "Longitud"
' Loop until Dir returns an empty string.
Do While FileName <> ""
' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & "\" & FileName)
' Set the cell in column A to be the file name.
SummarySheet.Range("A" & NRow).Value = FileName
' Set the source range to be A9 through C9.
' Modify this range for your workbooks.
' It can span multiple rows.
For i = 1 To 200
If InStr(1, LCase(Range("A" & i)), "GPS Latitude") <> 0 Then 'If GPS appears in the string then
icount = i
icount2 = icount + 1
Set S_Lat = WorkBk.Worksheets(1).Range("A" & icount) ' Set the S_Lat variable
Set S_Long = WorkBk.Worksheets(1).Range("A" & icount2) ' Set the S_Long variable
Exit For
End If
Next i
' Set the destination range to start at column B and
' be the same size as the source range.
' SummarySheet.Range("B" & NRow).Value = S_Lat.Value ***** Didnt work? ******
' SummarySheet.Range("C" & NRow).Value = S_Long.Value ***** Didnt work? ******
Set D_Lat = SummarySheet.Range("B" & NRow)
Set D_Long = SummarySheet.Range("C" & NRow)
' Copy over the values from the source to the destination.
D_Lat.Value = S_Lat.Value
D_Long.Value = S_Long.Value
' Increase NRow so that we know where to copy data next.
NRow = NRow + D_Lat.Rows.Count
' Close the source workbook without saving changes.
WorkBk.Close savechanges:=False
' Use Dir to get the next file name.
FileName = dir()
Loop
' Call AutoFit on the destination sheet so that all
' data is readable.
' SummarySheet.Columns.AutoFit
End Sub
This simple code is not giving you a complete working macro, it will Look for "Latitude" in column A and when found it will transfer the cel.value, and the cel.value below it, to two rows side-by-side in column B and column C on the same worksheet. You will need to wrap it inside your Workbooks.Open loop, modify the Range in the source worksheet to include a last row, include a last row for your new workbook's worksheet and add it to the code inside the If statement. Try to work this into your code and when you encounter problems, you can return to SO and ask a specific question concerning your macro. The macro was tested with actual longitudes and latitudes, in column A, an placed in columns B and C side-by-side.
Dim lRow As Long
lRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
For Each cel In Range("A1:A38")
If InStr(1, cel.Value, "Latitude") Then
x = x + 1
Cells(x, 2).Value = cel.Value
Cells(x, 3).Value = cel.Offset(1).Value
End If
Next cel

VBA - Loop through files in a folder ONLY if file not already included in a list

I am currently using a piece of code to loop through all files in a folder and copy certain cells from each file into a master list. Currently there are a number of files being added into the folder every week. The code is then re-ran and all files are looped through again. One of the columns in the master list includes the filenames of previously looped files.
I would like to modify this code to ONLY loop through files that have not previously been looped through (i.e files with filenames that are not already included in the list created by previously running the code) and add data into the already existing list. Here is the code that I am currently using:
Sub CopyFromFolderExample()
' updated 2018-11-13 by OPE
' copies values from the first worksheet from all workbooks in a given folder
Dim strFolder As String, strFile As String, r As Long, wb As Workbook
Dim varTemp(1 To 6) As Variant ' variable to hold the values you want to copy
Application.ScreenUpdating = False
strFolder = "D:\Other\Barbara's Bakery Ltd\Inv\" ' include last path separator
' prepare the target worksheet
With ThisWorkbook.Worksheets(1)
.Range("A4:E" & .Rows.Count).ClearContents ' clear any existing content below the header row
r = .Range("A" & .Rows.Count).End(xlUp).Row ' last non-empty row in column A
End With
strFile = Dir(strFolder & "*.xl*") ' the first workbook found in the folder
Do While Len(strFile) > 0 ' repeat for each *.xl* file in the folder
Application.StatusBar = "Reading data from " & strFile & "..."
Set wb = Workbooks.Add(strFolder & strFile) 'open a copy of the workbook, just in case it is already open
With wb.Worksheets(1) ' specify source worksheet
' read input values
varTemp(1) = .Range("A13").Value
varTemp(2) = .Range("H8").Value
varTemp(3) = .Range("H9").Value
varTemp(4) = .Range("H36").Value
varTemp(5) = .Range("H37").Value
varTemp(6) = strFile
End With
wb.Close False ' close the workbook copy, not necessary to save any changes
' write the values from the source workbook to the target worksheet
With ThisWorkbook.Worksheets(1)
r = r + 1
.Range("A" & r & ":F" & r).Formula = varTemp
End With
strFile = Dir ' next source workbook
Loop
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Given that you appear to be storing your previously looped book names in Column F, you can just look for your current books name there. If the book name is there, we will skip the file. If the book name is not there, we will proceed with your code.
You can use a function Looped to check for your value which will return either
TRUE: The book has already been looped
FALSE: The book has not been looped
You then need to build your action statements around the result of this function. If Not Looped(strFile, ws) Then which translates to If Looped = FALSE Then proceed.
I also declared a worksheet variable ws to get rid of two of your with blocks and to be able to pass this variable into the below function.
Option Explicit
Sub CopyFromFolderExample()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(1)
Dim strFolder As String, strFile As String, r As Long, wb As Workbook
Dim varTemp(1 To 6) As Variant
Application.ScreenUpdating = False
strFolder = "D:\Other\Barbara's Bakery Ltd\Inv\"
ws.Range("A4:E" & ws.Rows.Count).ClearContents
r = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
strFile = Dir(strFolder & "*.xl*")
Do While Len(strFile) > 0
If Not Looped(strFile, ws) Then
Application.StatusBar = "Reading data from " & strFile & "..."
Set wb = Workbooks.Add(strFolder & strFile)
With wb.Worksheets(1)
varTemp(1) = .Range("A13").Value
varTemp(2) = .Range("H8").Value
varTemp(3) = .Range("H9").Value
varTemp(4) = .Range("H36").Value
varTemp(5) = .Range("H37").Value
varTemp(6) = strFile
End With
wb.Close False
r = r + 1
ws.Range(ws.Cells(r, 1), ws.Cells(r, 6)).Formula = varTemp
End If
strFile = Dir
Loop
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Private Function Looped(strFile As String, ws As Worksheet) As Boolean
Dim Found As Range
Set Found = ws.Range("F:F").Find(strFile)
If Found Is Nothing Then
Looped = False
Else
Looped = True
End If
End Function

Combine CSV files with Excel VBA

I have some csv files in one folder. They all contain 3 specific columns. The number of total columns and the order may vary.
I want to concatenate all 3 columns with an underscore and write them in a single column in the worksheet that is running the code.
Here is what I have so far:
Option Explicit
Sub test()
Dim i As Long
Dim LastRow As Long
Dim Columns()
Columns = Array("Column1", "Column2", "Column3")
'Find Columns by Name
For i = 0 To 2
Columns(i) = Rows(1).Find(What:=Columns(i), LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchFormat:=False).Column
Next i
'Debug.Print Columns(0)
'Debug.Print Columns(1)
'Debug.Print Columns(2)
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
Cells(i, 1) = Cells(i, Columns(0)) & "_" & Cells(i, Columns(1)) & "_" & Cells(i, Columns(2))
Next i
End Sub
As you can see, this does what I want, but only for the active sheet.
I actually want to loop through all csv files in the same folder as the active sheet and write the results in the first sheet, first column of the sheet running the code (which is not a csv itself obviously).
How can I do this?
thanks!
This is a code that will loop through a folder
Sub Button1_Click()
Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
Set Wb = ThisWorkbook
'change the address to suite
MyDir = "C:\WorkBookLoop\"
MyFile = Dir(MyDir & "*.xls") 'change file extension
ChDir MyDir
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Do While MyFile <> ""
Workbooks.Open (MyFile)
'do something here
MyFile = Dir()
Loop
End Sub
It depends how you are naming the worksheets you create from the CSV files. You could add all the worksheets to a collection and use a For...Each loop to execute the entire search and concatenate procedure within that loop. Note that you'd have to explicitly define the first sheet name as this won't change through successive loops:
Option Explicit
Sub test()
Dim i As Long
Dim LastRow As Long
Dim Columns()
Dim frontSheet as Worksheet
Dim wSheets as New Collection
Dim ws as Worksheet
Set frontSheet = Sheets("name of front sheet")
'Add all your CSV sheets to wSheets using the .Add() method.
For Each ws in wSheets
Columns = Array("Column1", "Column2", "Column3")
'Find Columns by Name
For i = 0 To 2
Columns(i) = ws.Rows(1).Find(What:=Columns(i), LookIn:=xlValues, LookAt:=xlWhole, _
MatchCase:=False, SearchFormat:=False).Column
Next i
'Debug.Print Columns(0)
'Debug.Print Columns(1)
'Debug.Print Columns(2)
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LastRow
frontsheet.Cells(i, 1) = ws.Cells(i, Columns(0)) & "_" & ws.Cells(i, Columns(1)) & "_" & ws.Cells(i, Columns(2))
Next i
Next ws
End Sub
It's often slow and labourious to open CSV files in excel but VBA can read them as text files using a TextStream. Furthermore, file scripting objects let you work with files and directories directly. Something like this might be a better approach if you don't need to keep the files in a worksheet afterwards:
Sub SearchFoldersForCSV()
Dim fso As Object
Dim fld As Object
Dim file As Object
Dim ts As Object
Dim strPath As String
Dim lineNumber As Integer
Dim lineArray() As String
Dim cols() As Integer
Dim i As Integer
Dim frontSheet As Worksheet
Dim frontSheetRow As Integer
Dim concatString As String
Set frontSheet = Sheets("name of front sheet")
frontSheetRow = 1
strPath = "C:\where-im-searching\"
Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(strPath)
For Each file In fld.Files
If (Right(file.Name, 3) = "csv") Then
Debug.Print file.Name
Set ts = file.OpenAsTextStream()
lineNumber = 0
Do While Not ts.AtEndOfStream
lineNumber = lineNumber + 1
lineArray = Split(ts.ReadLine, ",")
If (lineNumber = 1) Then
'We are at the first line of the .CSV so
'find index in lineArray of columns of interest
'Add extra ElseIf as required
For i = LBound(lineArray) To UBound(lineArray)
If lineArray(i) = "Column 1" Then
cols(1) = i
ElseIf lineArray(i) = "Column 2" Then
cols(2) = i
ElseIf lineArray(i) = "Column 3" Then
cols(3) = i
End If
Next i
Else
'Read and store the column of interest from this
'row by reading the lineArray indices found above.
concatString = ""
For i = LBound(cols) To UBound(cols)
concatString = concatString & lineArray(i) & "_"
Next i
concatString = Left(concatString, Len(concatString) - 1)
frontSheet.Cells(frontSheetRow, 1).Value = concatString
frontSheetRow = frontSheetRow + 1
End If
Loop
ts.Close
End If
Next file
End Sub
You can find more information on FileSystemObject and TextStream here.

Resources