VBA Macro To Open And Modify Files By Looping Through Files In Folder

[Howardc]

I would like a macro that will do the following

1) open all CSV files in folder C:\Journals
2) Format Col's B:D to 2 decimal places
3) Save the files



Your assistance is most appreciated

[Excel Fox]

Try this


Sub OpenAndModifySameFileTypes()

Dim strFile As String
Dim strFileType As String
Dim strPath As String
Dim lngLoop As Long

strPath = "C:\Journals"
strFileType = "*.csv" 'Split with semi-colon if you want to specify the file types. Example ->> "*.xls;*.jpeg;*.doc;*.gif"

For lngLoop = LBound(Split(strFileType, ";")) To UBound(Split(strFileType, ";"))
strFile = Dir(strPath & "\" & Split(strFileType, ";")(lngLoop))
Do While strFile <> ""
With Workbooks.Open(strPath & "\" & strFile)
With .Sheets(1)
.Range("B1:D" & .UsedRange.Rows.Count).NumberFormat = "0.00"
End With
.Close 1
End With
strFile = Dir
Loop
Next lngLoop
strFile = vbNullString
strFileType = vbNullString
strPath = vbNullString
lngLoop = Empty

End Sub

[Howardc]

Thanks for the help, much appreciated

[Howardc]

Hi Excel Fox

I have tried to amend your code to do the following, but cannot get it to work

I would like to:
1) Hide the row where Col A contains data and COl B and C has no value in the same row as Col A
2) I want to delete 50 rows after the last row in Col A containing data

Regards

Howard



Sub OpenAndModifySameFileTypes()

Application.ScreenUpdating = False
Dim strFile As String
Dim strFileType As String
Dim strPath As String
Dim lngLoop As Long


strPath = "C:\PINNACLE Journal TEMPLATES"
strFileType = "*.csv" 'Split with semi-colon if you want to specify the file types. Example ->> "*.xls;*.jpeg;*.doc;*.gif"

For lngLoop = LBound(Split(strFileType, ";")) To UBound(Split(strFileType, ";"))
strFile = Dir(strPath & "\" & Split(strFileType, ";")(lngLoop))
Do While strFile <> ""
With Workbooks.Open(strPath & "\" & strFile)
With .Sheets(1)
.Range("B1:D" & .UsedRange.Rows.Count).NumberFormat = "0.00"
End With
With .Sheets(1)
Dim j As Integer, k As Integer
j = Range("a1").End(xlDown).Row
For k = j To 1 Step -1
If Cells(k, "B") = "" And Cells(k, "c") = "" Then
Cells(k, "A").EntireRow.Hidden = True
End If
Next k
Range(Cells(j + 1, "A"), Cells(j + 50, "A")).EntireRow.Delete
End If
End If
.Close 1
End With
End With
strFile = Dir
Loop
Next lngLoop
strFile = vbNullString
strFileType = vbNullString
strPath = vbNullString
lngLoop = Empty

End Sub

[snb]

Sub M_snb()
sn= split(createobject("wscript.shell").exec("cmd /c dir C:\Journals\*.csv /b").stdout.readall,vbcrlf)

for each it in sn
with getobject(it)
.sheets(1).cells(.application.rows.count,1).end(-4162).offset(1).resize(50).entirerow.delete
.sheets(1).columns(2).specialcells(4).entirerow.hi dden=true
.saveas replace(.fullname,".csv",".xlsx") ,51
end with
next
End Sub

[Howardc]

Thanks for the help. Where the is a value in Col A and no values in Col B & C, then the row must be hidden. In the attached sample, there is a value in A5, but nothing in Col B & C, therefore Row 5 must be hidden. Kindly amend your code accordingly

[snb]

I don't want to hurt your pride: I think you will be able to amend the code yourself.

[Howardc]

I will certainly give it a bash

[Howardc]

Hi snb & Excel Fox

I have amended my code, but when hiding the row manually and saving and then re-opening , I realised that you cannot hide a column in a CSV file as when it its re-opened the row is no longer hidden

[Excel Fox]

Why don't you process a CSV file and save the file as an Excel file, and delete the original CSV file using code?

[Howardc]

Hi Excel Fox

I had a rethink. Where there are Col A is blank, then the entire row must be deleted for Eg if A7 , A11 is blank then these rows must be deleted, not hidden

I have tried to write the code, but cannot get it to work.

I have attached 3 CSV files-one containing raw data, one after running the macro and one showing what the data should look like after running the macro



Your assistance in this regard is most appreciated


Sub OpenAndModifySameFileTypes()

Application.ScreenUpdating = False
Dim strFile As String
Dim strFileType As String
Dim strPath As String
Dim lngLoop As Long


strPath = "C:\PINNACLE Journal TEMPLATES"
strFileType = "*.csv" 'Split with semi-colon if you want to specify the file types. Example ->> "*.xls;*.jpeg;*.doc;*.gif"

For lngLoop = LBound(Split(strFileType, ";")) To UBound(Split(strFileType, ";"))
strFile = Dir(strPath & "\" & Split(strFileType, ";")(lngLoop))
Do While strFile <> ""
With Workbooks.Open(strPath & "\" & strFile)
With .Sheets(1)
.Range("B1:D" & .UsedRange.Rows.Count).NumberFormat = "0.00"
Sheets(1).Select
Dim j As Integer, k As Integer
j = Range("a1").End(xlDown).Row
For k = j To 1 Step -1
If Cells(k, "B") = "" And Cells(k, "c") = "" Then
Cells(k, "A").EntireRow.Delete
End If
Range(Cells(j + 1, "A"), Cells(j + 50, "A")).EntireRow.Delete
Next k

End With
.Close 1
End With
strFile = Dir
Loop
Next lngLoop
strFile = vbNullString
strFileType = vbNullString
strPath = vbNullString
lngLoop = Empty

End Sub

[Excel Fox]

Try this

Sub OpenAndModifySameFileTypes()
Application.ScreenUpdating = False
Dim strFile As String
Dim strFileType As String
Dim strPath As String
Dim lngLoop As Long



strPath = "C:\PINNACLE Journal TEMPLATES"
strFileType = "*.csv" 'Split with semi-colon if you want to specify the file types. Example ->> "*.xls;*.jpeg;*.doc;*.gif"

For lngLoop = LBound(Split(strFileType, ";")) To UBound(Split(strFileType, ";"))
strFile = Dir(strPath & "\" & Split(strFileType, ";")(lngLoop))
Do While strFile <> ""
With Workbooks.Open(strPath & "\" & strFile)
With .Sheets(1)
.Range("B2:D" & .UsedRange.Rows.Count).NumberFormat = "0.00"
.UsedRange.Sort Key1:=.Columns("A"), Order1:=1, Header:=1
End With
.Close 1
End With
strFile = Dir
Loop
Next lngLoop
strFile = vbNullString
strFileType = vbNullString
strPath = vbNullString
lngLoop = Empty

End Sub

[Howardc]

Hi Excelfox

Thanks for the help, much appreciated. I need one more favour. I would like to delete 50 rows after the last value in Col A

[Excel Fox]

Add this line after the sorting


.Cells(1).Offset(.UsedRange.Rows.Count).Resize(50) .EntireRow.Delete

[Excel Fox]

Or


.Cells(.Rows.Count).End(xlup)(2).Resize(50).Entire Row.Delete

[Howardc]

Hi Excelfox

Thanks for all the assistance, which is highly appreciated