Hi Sweepin,
I altered your code a little with a couple of comments - see if it's any quicker:
![]()
Sub New_Clean() ' ' Macro2 Macro ' Dim PathName As String 'Dim FileName As String could be risky as FileName may be reserved word Dim NewBook As String Dim CurrentWB As Workbook Dim Pic As Object PathName = "C:\BoxScoreTest\" NewBook = Dir(PathName & "*.xls") Do While NewBook <> "" Set CurrentWB = Workbooks.Open(PathName & NewBook, 0) '0 here knocks off the update links With CurrentWB.ActiveSheet .Rows("1:30").Delete Shift:=xlUp With .UsedRange.Font .Name = "Verdana" .Size = 10 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .TintAndShade = 0 .ThemeFont = xlThemeFontNone .ColorIndex = xlAutomatic Range("A1:BR500").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft Columns("I:BX").Select Selection.Delete Shift:=xlToLeft Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove For Each Pic In ActiveSheet.Pictures Pic.Delete Next Pic End With End With CurrentWB.Close True NewBook = Dir() Loop End Sub
Bookmarks