-
Jun 10th, 2021, 04:43 AM
#1
Thread Starter
Registered User
Use VBA to run a code on multiple excel files yet each doesn't save a new sheet
Hi, I am super new to VBA language and I am trying to fix my code.
I want to run my macro on multiple files and I have found a code to so. My macro is to find certain rows based on keywords and save them on a new sheet.
Yet when I run on multiple files, it doesn't have the new sheet.
If better, is there a way to save the found rows from all excel workbooks in the folder into one new workbook?
Here is my code. Really appreciate the help
Code:
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim strArray As Variant
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim NoRows As Long
Dim DestNoRows As Long
Dim I As Long
Dim J As Integer
Dim rngCells As Range
Dim rngFind As Range
Dim Found As Boolean
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(fileName:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'Change First Worksheet's Background Fill Blue
strArray = Array("stent", "Stent") 'put your keywords here'
Set wsSource = wb.Sheets(1)
wsSource.Select
Set wsSource = ActiveSheet 'just open one worksheet'
NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add
For I = 1 To NoRows
Set rngCells = wsSource.Range("D" & I & ":D" & I) 'specify range in the parentheses, if only want to search one column, put from D to D'
Found = False
For J = 0 To UBound(strArray)
Found = Found Or Not (rngCells.Find(strArray(J)) Is Nothing)
Next J
If Found Then
rngCells.EntireRow.Copy wsDest.Range("A" & DestNoRows)
DestNoRows = DestNoRows + 1
End If
Next I
'Save and Close Workbook
wb.Close SaveChanges:=True
'Ensure Workbook has closed before moving on to next line of code
DoEvents
'Get next file name
myFile = Dir
Loop
'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
-
Jun 11th, 2021, 05:16 AM
#2
Re: Use VBA to run a code on multiple excel files yet each doesn't save a new sheet
Set wsSource = wb.Sheets(1)
wsSource.Select
Set wsSource = ActiveSheet 'just open one worksheet'
NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = ActiveWorkbook.Worksheets.Add
you should avoid selecting anything or using active anything, to prevent errors, especially when working with multiple workbooks
try like
Code:
Set wsSource = wb.Sheets(1)
Set wsSource = wb.sheets(1)'just open one worksheet'
NoRows = wsSource.Range("A65536").End(xlUp).Row
DestNoRows = 1
Set wsDest = wb.Worksheets.Add
If better, is there a way to save the found rows from all excel workbooks in the folder into one new workbook?
yes of course this is quite possible
change the last line above to
Code:
set wsdest = workbooks.add.sheets(1)
you should move that line to above the start of the loop opening files, also the line setting destnorows =1
make sure to save and close the new workbook after the loop
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|