vba macro looping through files but failing to loop through worksheets

Question

I've created a vba macro with the intention of: 1) Opening each file in a folder one by one 2) Loop through each worksheet, unprotect each sheet see if the top row is blank (and delete it if it is) and delete a problematic column. 3) Save the file as an xlsx.

So far I've managed to get it to loop through every file but fail to loop through the worksheets. I was previously able to get it to make changes to the last active worksheet in each workbook but now it seems to skip every worksheet.

Any idea why?

Sub LoopThroughFiles()

    FolderName = ThisWorkbook.Path & "\Source Data\"
    If Right(FolderName, 1) <> Application.PathSeparator Then FolderName = FolderName & Application.PathSeparator
    Fname = Dir(FolderName & "*.xls*")

    'loop through the files
    Do While Len(Fname)

        With Workbooks.Open(FolderName & Fname)
    Dim folderPath As String
    Dim filename As String
    Dim wb As Workbook
    Dim ws As Worksheet


Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

'Unshare Workbook
If ActiveWorkbook.MultiUserEditing Then
    ActiveWorkbook.ExclusiveAccess
End If

'Unprotect Workbook
ActiveWorkbook.Unprotect "pa55word"


For Each ws In ThisWorkbook.Worksheets

'Unprotect Worksheet
ws.Unprotect "pa55word"

'Unhide Columns and Rows
            ws.Cells.EntireColumn.Hidden = False
            ws.Cells.EntireRow.Hidden = False


 'Delete Blank top Row
 Set MR = ws.Range("A1:C1")
 For Each cell In MR
 If cell.Value = "" Then cell.EntireRow.Delete
 Next

  'Delete annoying Column
 Set MR = ws.Range("A1:BZ1")
 For Each cell In MR
 If cell.Value = "a2a" Then cell.EntireColumn.Delete
 Next

 'Remove Filter

 If ws.AutoFilterMode Then
 ws.ShowAllData
 ws.AutoFilterMode = False
 End If

 Next ws


ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Cleansed Data\" & Replace(Replace(ActiveWorkbook.Name, ".xlsx", ""), ".xls", "") & ".xlsx", FileFormat:=51
ActiveWorkbook.Close

        End With

        ' go to the next file in the folder
        Fname = Dir

    Loop



End Sub

Answer 1

You are using ActiveSheet to unprotect in the loop.

Change it to this one:

 For Each ws In ThisWorkbook.Worksheets
                'Unprotect Worksheet
                ws.Unprotect "pa55word" 'instead of ActiveSheet.Unprotect ~

Otherwise it stays protected and you cannot do the changes. In general, avoid working with ActiceCell, ActiveSheet and etc - How to avoid using Select in Excel VBA

Furthermore, set the MR range like this:

'Delete Blank top Row
Set MR = ws.Range("A1:C1")
For Each cell In MR
    If cell.Value = "" Then cell.EntireRow.Delete
Next

'Delete annoying Column
Set MR = ws.Range("A1:BZ1")
For Each cell In MR
    If cell.Value = "2a2" Then cell.EntireColumn.Delete
Next

You have to refer to the ws parent, when you are setting the range. Otherwise it takes the ActiveSheet.

---

And here as well:

 If ws.AutoFilterMode Then
     ws.ShowAllData
     ws.AutoFilterMode = False
 End If

Answer 2

It is always Excel.Object, Workbook.Object, Worksheet.Object, and Range.Object; 4 objects total. Please take a look at this link.

http://www.excelfunctions.net/Excel-Objects.html

Also, see this link.

http://www.excel-easy.com/vba/examples/loop-through-books-sheets.html

So, now with your new education, you are ready to do the actual work.

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

    'Fill in the path\folder where the files are
    MyPath = "C:\Users\Ron\test"

    '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
                        .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

https://www.rondebruin.nl/win/s3/win010.htm