Automating open Excel file/Run Script/Then Save Process with a VBA Script

PROBLEM SOLVED :check:

Hello,

I'm trying to build a database in Access by importing and appending hundreds of Excel documents in a certain folder together. Each imported excel spreadsheet needs to be basically uniform if it is to be appended correctly to the last excel spreadsheet in Access. In addition, blank spaces in the cells cause problems in access...
Since there are hundreds of excel files to be added to Access, I wished to use VBA to automate the process... so here's what I'd like to accomplish:


1st) The macro first scans through the folder with all Excel spreadsheets I wish to import... and automatically opens a single excel file at a time.
2nd) Checks that excel file to see that all blank spaces are filled with " - "
3rd) When it is, save that updated excel copy to a folder I name "New Project"
4th) repeat process on the next spreadsheet

Here's the code I've written so far.. but haven't been able to have it Automatically open each file I need from a particular folder, run the rest of the script, then save it...

Code:

---

Sub Formatting()

Dim counter As Integer
Dim TotalFiles As Integer
TotalFiles = 1

'Loop through each xl file in a folder
For counter = 1 To TotalFiles


'Open multiple Files----------------------------------------------------------------------------------------------
Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim xlFile As Variant

Filter = "Excel Files (*.xls), *.xls," & "Text Files (*.txt), *.txt," & "All files (*.*), *.*"

'Default filter = *.*
FilterIndex = 3
'Set dialog caption

Title = "Select File(s) to Open"
'Select Start and Drive path
ChDrive ("C")
ChDir ("C:\Users\DTurcotte\Desktop\Test_Origin")

With Application
    'Set file name array to selected files (allow multiple)
    xlFile = .GetOpenFilename(Filter, FilterIndex, Title, , True)
   'Reset Start Drive/Path
    ChDrive (Left(.DefaultFilePath, 1))
    ChDir (.DefaultFilePath)
End With

'Exit on Cancel
If Not IsArray(xlFile) Then
    MsgBox "No file was selected."
    Exit Sub
End If
'Open Files
For i = LBound(xlFile) To UBound(xlFile)
    msg = msg & xlFile(i) & vbCrLf
    Workbooks.Open xlFile(i)
Next i
MsgBox msg, vbInformation, "Files Opened"



'Format Column Headings----------------------------------------------------------------------------------------------
ActiveWorkbook.Sheets.Select

Dim RowIndex As Integer
Dim ColIndex As Integer
Dim totalRows As Integer
Dim totalCols As Integer

Dim LastRow As Long
Dim range As range


totalRows = Application.WorksheetFunction.CountA(Columns(1))

If Cells(1, 1).Value <> "ROOM #" Then Cells(1, 1).Value = "ROOM #"
If Cells(1, 2).Value <> "ROOM NAME" Then Cells(1, 2).Value = "ROOM NAME"
If Cells(1, 3).Value <> "HOMOGENEOUS AREA" Then Cells(1, 3).Value = "HOMOGENEOUS AREA"
If Cells(1, 4).Value <> "SUSPECT MATERIAL DESCRIPTION" Then Cells(1, 4).Value = "SUSPECT MATERIAL DESCRIPTION"

If Cells(1, 5).Value <> "ASBESTOS CONTENT (%)" Then Cells(1, 5).Value = "ASBESTOS CONTENT (%)"
If Cells(1, 6).Value <> "CONDITION" Then Cells(1, 6).Value = "CONDITION"
If Cells(1, 7).Value <> "FLOORING (SF)" Then Cells(1, 7).Value = "FLOORING (SF)"
If Cells(1, 8).Value <> "CEILING (SF)" Then Cells(1, 8).Value = "CEILING (SF)"

If Cells(1, 9).Value <> "WALLS (SF)" Then Cells(1, 9).Value = "WALLS (SF)"
If Cells(1, 10).Value <> "PIPE INSULATION (LF)" Then Cells(1, 10).Value = "PIPE INSULATION (LF)"
If Cells(1, 11).Value <> "PIPE FITTING INSULATION (EA)" Then Cells(1, 11).Value = "PIPE FITTING INSULATION (EA)"
If Cells(1, 12).Value <> "DUCT INSULATION (SF)" Then Cells(1, 12).Value = "DUCT INSULATION (SF)"

If Cells(1, 13).Value <> "EQUIPMENT INSULATION (SF)" Then Cells(1, 13).Value = "EQUIPMENT INSULATION (SF)"
If Cells(1, 14).Value <> "MISC. (SF)" Then Cells(1, 14).Value = "MISC. (SF)"
If Cells(1, 15).Value <> "MISC. (LF)" Then Cells(1, 15).Value = "MISC. (LF)"

'Fills in blank spaces with "-"
For RowIndex = 1 To totalRows
    For ColIndex = 1 To 15
        If Cells(RowIndex, ColIndex).Value = "" Then Cells(RowIndex, ColIndex).Value = "test"
        Next ColIndex
        Next RowIndex
       
'Clears content from "Totals" Row
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
       
    End With
    Rows(LastRow).ClearContents
   
'Saves file to a new folder
'Need to have the code run through that excel doc, set that updated copy to a variable, and then have the following code save it to a new folder

'newSaveName = updated excel file
'ActiveWorkbook.SaveAs ("C:\Users\DTurcotte\Desktop\TestExcelFiles" & Test1_Success & ".xls")

Next counter
   

End Sub

---

----------------------------
Can anyone provide any help?
Thank you!!!

so what happens?
nothing, error or unexpected result?
how many file names in msgbox msg?
do any files get modified?

remove the for counter loop as it is selecting the files every time

Quote:

---

TotalFiles = 1

'Loop through each xl file in a folder
For counter = 1 To TotalFiles

---

which is like saying for counter = 1 to 1, not much of a loop

you should open process and close each file in turn, currently you are opening all the files before any processing

vb Code:

If Not IsArray(xlFile) Then
    MsgBox "No file was selected."
    Exit Sub
End If
'Open Files
For i = LBound(xlFile) To UBound(xlFile)
    'msg = msg & xlFile(i) & vbCrLf
    set wbk = Workbooks.Open( xlFile(i))
    ' code to process changes to wbk
    wbk.saveAs savfolder & wbk.name ' same filename different folder
    wbk.close
Next i

add savfolder = "yourpath\foldername\" at the top somewhere

Thank you for the response... I'm still getting errors...

It's saying "No file selected" when I clearly give it a file to open. And also, I don't want to manually hard code the file name in for it to open.. I'd like it to loop through a folder called "VBA Origin", apply the formatting script, then save that updated copy to another folder called "VBA Target".

I tried following what you said to do:

Code:

---

Option Explicit


Sub Formatting()

'Open multiple Files----------------------------------------------------------------------------------------------

Dim Filter As String, Title As String, msg As String
Dim i As Integer, FilterIndex As Integer
Dim xlFile As Variant
Dim saveFolder As Variant
Dim wbk As Variant

Dim RowIndex As Integer
Dim ColIndex As Integer
Dim totalRows As Integer
Dim totalCols As Integer

Dim LastRow As Long
Dim range As range

saveFolder = "C:\Users\DTurcotte\Desktop\VBA Target"
totalRows = Application.WorksheetFunction.CountA(Columns(1))

'With Application

'opening workbook
Workbooks.Open ("C:\Users\Mobile Student\Desktop\VBA Origin\Test2.xlsx")

If Not IsArray(xlFile) Then
    MsgBox "No file was selected."
    Exit Sub
    End If
 
For i = LBound(xlFile) To UBound(xlFile)
    Set wbk = Workbooks.Open(xlFile(i))
    wbk.Visible = True
   
    ActiveWorkbook.Sheets.Select


'Format Column Headings----------------------------------------------------------------------------------------------
If Cells(1, 1).Value <> "ROOM #" Then Cells(1, 1).Value = "ROOM #"
If Cells(1, 2).Value <> "ROOM NAME" Then Cells(1, 2).Value = "ROOM NAME"
If Cells(1, 3).Value <> "HOMOGENEOUS AREA" Then Cells(1, 3).Value = "HOMOGENEOUS AREA"
If Cells(1, 4).Value <> "SUSPECT MATERIAL DESCRIPTION" Then Cells(1, 4).Value = "SUSPECT MATERIAL DESCRIPTION"

If Cells(1, 5).Value <> "ASBESTOS CONTENT (&#37;)" Then Cells(1, 5).Value = "ASBESTOS CONTENT (%)"
If Cells(1, 6).Value <> "CONDITION" Then Cells(1, 6).Value = "CONDITION"
If Cells(1, 7).Value <> "FLOORING (SF)" Then Cells(1, 7).Value = "FLOORING (SF)"
If Cells(1, 8).Value <> "CEILING (SF)" Then Cells(1, 8).Value = "CEILING (SF)"

If Cells(1, 9).Value <> "WALLS (SF)" Then Cells(1, 9).Value = "WALLS (SF)"
If Cells(1, 10).Value <> "PIPE INSULATION (LF)" Then Cells(1, 10).Value = "PIPE INSULATION (LF)"
If Cells(1, 11).Value <> "PIPE FITTING INSULATION (EA)" Then Cells(1, 11).Value = "PIPE FITTING INSULATION (EA)"
If Cells(1, 12).Value <> "DUCT INSULATION (SF)" Then Cells(1, 12).Value = "DUCT INSULATION (SF)"

If Cells(1, 13).Value <> "EQUIPMENT INSULATION (SF)" Then Cells(1, 13).Value = "EQUIPMENT INSULATION (SF)"
If Cells(1, 14).Value <> "MISC. (SF)" Then Cells(1, 14).Value = "MISC. (SF)"
If Cells(1, 15).Value <> "MISC. (LF)" Then Cells(1, 15).Value = "MISC. (LF)"

'Fills in blank spaces with "-"
For RowIndex = 1 To 10
    For ColIndex = 1 To 15
        If Cells(RowIndex, ColIndex).Value = "" Then Cells(RowIndex, ColIndex).Value = "test"
        Next ColIndex
        Next RowIndex
   
    'Saves file to a new folder
    wbk.SaveAs saveFolder & wbk.Name 'same filename different folder
   
    wbk.Close
   
Next i
MsgBox msg, vbInformation, "Files Opened"

---

you still needed the first part of your code, to select the files, but

if you just want all the files in a specific directory, then you do not need to use getopenfilename
change the loop of xlfiles to

vb Code:

srcfolder = ' your path with trailing \
fname = dir(srcfolder & "*.xlsx")  ' get first file name to match pattern
do until len(fname) = 0  ' stop loop when no more files found
set wbk = workbooks.open(srcfolder & fname)
  set sht = wbk.sheets("sheet1")  ' set sheet object, change sheet name to suit, or use index
  ' do all processing with workbook
  wbk.saveas savfolder & fname
  wbk.close
  fname = dir   ' get next file name
loop

use wbk or sht objects, at all times to refer to the workbook you are processing, avoid using activeworkbook as this can lead to errors, all ranges or cells are then ranges within the sht object
also use trailing backslash for savfolder
saveFolder = "C:\Users\DTurcotte\Desktop\VBA Target\"

you can then use like

vb Code:

with sht
   If .Cells(1, 1).Value <> "ROOM #" Then .Cells(1, 1).Value = "ROOM #"
   'etc
end with

if you always look to see if the value is not a value then set it to a value, it is probably faster to just set the value whether it is or not the value already, you should also turn off screenupdating too application.screenupdating = false.
if you want to use totalrows variable it should be assigned a value for each workbook after it is open

Quote:

---

Originally Posted by westconn1

you still needed the first part of your code, to select the files, but

if you just want all the files in a specific directory, then you do not need to use getopenfilename
change the loop of xlfiles to

vb Code:

srcfolder = ' your path with trailing \
fname = dir(srcfolder & "*.xlsx")  ' get first file name to match pattern
do until len(fname) = 0  ' stop loop when no more files found
set wbk = workbooks.open(srcfolder & fname)
  set sht = wbk.sheets("sheet1")  ' set sheet object, change sheet name to suit, or use index
  ' do all processing with workbook
  wbk.saveas savfolder & fname
  wbk.close
  fname = dir   ' get next file name
loop

use wbk or sht objects, at all times to refer to the workbook you are processing, avoid using activeworkbook as this can lead to errors, all ranges or cells are then ranges within the sht object
also use trailing backslash for savfolder
saveFolder = "C:\Users\DTurcotte\Desktop\VBA Target\"

you can then use like

vb Code:

with sht
   If .Cells(1, 1).Value <> "ROOM #" Then .Cells(1, 1).Value = "ROOM #"
   'etc
end with

if you always look to see if the value is not a value then set it to a value, it is probably faster to just set the value whether it is or not the value already, you should also turn off screenupdating too application.screenupdating = false.
if you want to use totalrows variable it should be assigned a value for each workbook after it is open

---

Awesome...
Thank you for your help.

I ended up changing:

If Cells(1, 1).Value <> "ROOM #" Then Cells(1, 1).Value = "ROOM #"
If Cells(1, 2).Value <> "ROOM NAME" Then Cells(1, 2).Value = "ROOM NAME"
If Cells(1, 3).Value <> "HOMOGENEOUS AREA" Then Cells(1, 3).Value = "HOMOGENEOUS AREA"

To:

an array...
ColumnHeading = Array("ROOM #", "ROOM NAME", "HOMOGENEOUS AREA", ...

Code looks nice and smooth.