Search macro for greater than 100000 on multiple CSV files

D

Dirkmiller

Hi,

i am trying to create a macro, which will run through a folder o
different csv files and search for values of 100000 and then copy th
entire row into a new workbook, which ideally will get updated ever
day.

is this possible? as the files have different names which is one area
struggle with and i struggle with copying the data into a standar
workbook (which can be in another folder if need be)

thanks Dir
 
A

Auric__

Dirkmiller said:
i am trying to create a macro, which will run through a folder of
different csv files and search for values of 100000 and then copy the
entire row into a new workbook, which ideally will get updated every
day.

is this possible? as the files have different names which is one area i
struggle with and i struggle with copying the data into a standard
workbook (which can be in another folder if need be)

As with everything else I post, this is horribly inefficient and probably
not the best way to do this... but it works. (For me, anyway.)

Sub findInFiles()
Dim tmp As String
Workbooks.Add
Const VALUETOFIND = "100000"
backdir = CurDir$
ChDrive "X" 'only needed if the CSVs are on a different drive
ChDir "X:\directory\containing\the\CSV\files"
curfile = Dir$("*.csv")
While Len(curfile)
Open curfile For Binary As 1
tmp = Space$(LOF(1))
Get #1, 1, tmp
Close 1
'check if VALUETOFIND is in the file
If InStr(tmp, "," & VALUETOFIND & ",") Or _
InStr(tmp, vbNewLine & VALUETOFIND & ",") Or _
InStr(tmp, "," & VALUETOFIND & vbNewLine) Or _
(Left(tmp, Len(VALUETOFIND) + 1) = VALUETOFIND & ",") Or _
(Right(tmp, Len(VALUETOFIND) + 1) = "," & VALUETOFIND) Then
arr = Split(tmp, vbNewLine)
'find the line(s) containing VALUETOFIND
For i = 0 To UBound(arr)
If InStr(arr(i), "," & VALUETOFIND & ",") Or _
(Left(arr(i), Len(VALUETOFIND) + 1) = VALUETOFIND & ",") Or _
(Right(arr(i), Len(VALUETOFIND) + 1) = "," & VALUETOFIND) Then
importarr = Split(arr(i), ",")
nextrow = Cells.SpecialCells(xlCellTypeLastCell).Row + 1
For j = 0 To UBound(importarr)
'up to you to determine what nextrow is
Cells(nextrow, j + 1).Value = importarr(j)
Next
End If
Next
End If
curfile = Dir$
Wend
'save it
fname = Application.GetSaveAsFilename
If fname Then ActiveWorkbook.SaveAs fname
ChDrive backdir
ChDir backdir
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top