Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.
One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.
Sub LoopAllExcelFilesInFolder() 'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 'SOURCE: www.TheSpreadsheetGuru.com Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog '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 = "*.xlsx" '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 wb.Worksheets("PRODUCT").Range("C17").Resize(4, 0).Value = "NT" wb.Worksheets("PRODUCT").Range("C21").Resize(3, 0).Value = "ER" wb.Worksheets("PRODUCT").Range("B9").Value = "CE" wb.Worksheets("PRODUCT").Range("D23").Value = "Y" wb.Worksheets("PRODUCT").Range("E29").Resize(0, 1).Value = "N" wb.Worksheets("PRODUCT").Range("G29").Value = "B" wb.Worksheets("PRODUCT").Range("B33").Value = "C" '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
|Problem with a moving column in Excel||6||38|
|List Box Entries Excel 2010||5||29|
|split user ID and domain name from email addresses using formula||3||16|
|vba copy paste previous line||3||13|