Hello,
The following vba opens each workbook in the temp folder and changes the name of the first column header. I am wondering if it is possible to modify it so instead of change the first column header, it selects all the rows in the worksheet, and subtotals all of the columns after the third column at each change in column 2
The data I have is phone data so each day of the month the previous day will be added to the worksheet so the range will change every day when it is run.
I attached a file showing how the data is naturally and how I would like to see it after the update
I have been looking up range object and subtotal method but I am not getting it at all.
Thanks as always
Code:Sub Example() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String, Fnum As Long Dim mybook As Workbook Dim CalcMode As Long Dim sh As Worksheet Dim ErrorYes As Boolean Dim rng As Range Dim cell As Range 'Fill in the path\folder where the files are MyPath = "C:\Temp" 'Add a slash at the end if the user forget it If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" End If 'If there are no Excel files in the folder exit the sub FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If 'Fill the array(myFiles)with the list of Excel files in the folder Fnum = 0 Do While FilesInPath <> "" Fnum = Fnum + 1 ReDim Preserve MyFiles(1 To Fnum) MyFiles(Fnum) = FilesInPath FilesInPath = Dir() Loop 'Change ScreenUpdating, Calculation and EnableEvents With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With 'Loop through all files in the array(myFiles) If Fnum > 0 Then For Fnum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum)) On Error GoTo 0 If Not mybook Is Nothing Then 'Change cell value(s) in one worksheet in mybook On Error Resume Next With mybook.Worksheets(1) If .ProtectContents = False Then ' Set rng = Range("A1").CurrentRegion ' ' For Each cell In rng ' If cell.Value Is Null Then cell.Value = 0 ' Next cell .Range("A1").Value = "My New Header" Else ErrorYes = True End If End With If Err.Number > 0 Then ErrorYes = True Err.Clear 'Close mybook without saving mybook.Close savechanges:=False Else 'Save and close mybook mybook.Close savechanges:=True End If On Error GoTo 0 Else 'Not possible to open the workbook ErrorYes = True End If Next Fnum End If If ErrorYes = True Then MsgBox "There are problems in one or more files, possible problem:" _ & vbNewLine & "protected workbook/sheet or a sheet/range that not exist" End If 'Restore ScreenUpdating, Calculation and EnableEvents With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub Green.zip