Loop macro works on individual sheets, but locks up when looping through multiple sheets.

[TrainingExcellence]

Greetings!

I've been learning VBA and have found this forum to be extremely helpful! This is my first post. I'm having trouble with a macro I'm creating at work. I have a number of xls-refreshable reports exported from another software program. The macro I'm creating is meant to move all relevant information onto one sheet (Consolidation) from which I will create a pivot table. Each worksheet has its own data connection. The strange thing is the following code works when I run it on individual worksheets (using step-into mode), but when I run the entire code, looping through each sheet in workbook, it locks up. I don't understand why. Is there anything obviously wrong with the code?

Sub LearningPlans()

'Tweaks to speed up macros
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False


'Unhide all worksheets
    Dim ws As Worksheet
 
    For Each ws In ActiveWorkbook.Worksheets
        ws.Visible = xlSheetVisible
    Next ws
            
'Setup a worksheet called "Consolidation" to which you will compile data from all other worksheets. The "Consolidation" sheet will be used to build a pivot table.
    With Sheets("Consolidation")
        .UsedRange.ClearContents
        .Range("A1:A2").FormulaR1C1 = "Employee Name"
        .Range("B1:B2").FormulaR1C1 = "Title"
        .Range("C1:C2").FormulaR1C1 = "Trainings"
        .Range("D1:D2").FormulaR1C1 = "Status"
        .Range("A2:D2").Font.Bold = True
    End With


'Format every data sheet and copy select data to the "Consolidation" sheet.
    
    Sheets(1).Select
    
    Do Until ActiveSheet.Name = "Consolidation"
        
    'Refresh data
        ActiveSheet.UsedRange.ClearContents
        With Range("A1").QueryTable
        .BackgroundQuery = False
        .Refresh
        End With
            
    ' Undo wrap text and switch to General
        With Range("A1").CurrentRegion
            .WrapText = False
            .NumberFormat = "general"
        End With
    
    'Concatenate employees' names
        Range("B:B").Insert Shift:=xlToRight
        Range("B1").FormulaR1C1 = "Employee Name"
        Range("B1").Offset(1, 1).Range("A1").Select
        
        Do Until ActiveCell = ""
            ActiveCell.Offset(0, -1).Range("A1").FormulaR1C1 = "=CONCATENATE(RC[2],"" "",RC[1])"
            ActiveCell.Offset(1, 0).Range("A1").Select
        Loop
             
        With Range("b1", Range("b1").End(xlDown))
        .Copy
        .PasteSpecial Paste:=xlPasteValues
        End With
        
    'Insert two columns next to each course column. One column displays the course name in every row of the range, and the second column displays "Needs Training" or "Passed" in each of its rows.
        Selection.End(xlToRight).Offset(0, -2).Select
        Do Until ActiveCell = "Date of Hire" 'Loops right to left of worksheet through each of the course columns.
        i = i + 1 'Counts the number of loop iterations. Used later in the macro.
            ActiveCell.Resize(, 2).EntireColumn.Insert
            ActiveCell.FormulaR1C1 = "Courses"
            ActiveCell.Offset(0, 1).FormulaR1C1 = "=RC[1]"
            ActiveCell.Offset(1, 2).Select
        
        Do Until ActiveCell = ""
        With ActiveCell
        .Offset(0, -1).FormulaR1C1 = _
                "=IF(RC[1]=""Not Attempted"",""Needs Training"",IF(RC[1]=""In Progress"",""Needs Training"",""Passed""))"
        .Offset(0, -2).FormulaR1C1 = "=R1C[2]"
        End With
        ActiveCell.Offset(1, 0).Select
        Loop
        Selection.Offset(-1, 0).End(xlUp).Offset(0, -2).Range("a1:b1").Select
        Range(Selection, Selection.End(xlDown)).Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        
    'Send data to "Consolidation" sheet
        numRows = Selection.Rows.Count
        numColumns = Selection.Columns.Count
        Selection.Resize(numRows - 1, numColumns).Select
        Selection.Offset(1, 0).Select
        Dim CurrentWorksheet As Range
        Set CurrentWorksheet = Selection
        Dim ConsolidationCourses As Range
        Set ConsolidationCourses = Worksheets("Consolidation").Range("c1").End(xlDown).Offset(1, 0)
        CurrentWorksheet.Copy Destination:=ConsolidationCourses
        ActiveCell.Offset(-1, -1).Select
        
        Loop 'Repeat on remaining courses
    
        ActiveCell.Offset(0, -5).End(xlDown).Select
        Range(Selection, Selection.End(xlUp).Offset(1, 0)).Select
        
        For counter = 1 To i
        
        Set CurrentWorksheet = Selection
        Dim strEmployeeNames As Range
        Set strEmployeeNames = Worksheets("Consolidation").Range("a1").End(xlDown).Offset(1, 0)
        CurrentWorksheet.Copy Destination:=strEmployeeNames
        
        Next
        
        Do Until ActiveCell = ""
        ActiveCell.Offset(0, 3).Formula = ActiveSheet.Name
        ActiveCell.Offset(1, 0).Select
        Loop
        
        Range(ActiveCell.Offset(-1, 3), ActiveCell.Offset(-1, 3).End(xlUp).Offset(1, 0)).Select
        With Selection
        .Copy
        .PasteSpecial Paste:=xlPasteValues
        End With
        
        For counter = 1 To i
        Set CurrentWorksheet = Selection
        Dim strEmployeeTitles As Range
        Set strEmployeeTitles = Worksheets("Consolidation").Range("b1").End(xlDown).Offset(1, 0)
        CurrentWorksheet.Copy Destination:=strEmployeeTitles
        Next
        
        ActiveWindow.ActiveSheet.Visible = False
        Loop
        
    'Speed up macros, ending
        Application.Calculation = xlCalculationAutomatic
        Application.DisplayStatusBar = True
        Application.EnableEvents = True
        ActiveSheet.DisplayPageBreaks = True
        Application.ScreenUpdating = True
        
    End Sub

Thanks!
Ben

 

[Norie]

Which sheets should the code run on?

By the way, why aren't you only using this to make sheets visible?

    For Each ws In ActiveWorkbook.Worksheets
        ws.Visible = xlSheetVisible
    Next ws

This should be your main loop and it's where you should be working with each sheet in turn.

 

[Guru008]

For Each ws In ActiveWorkbook.Worksheets

your whole code here as you need to run code for each cell


Next ws

 

[footoo]

Also, could try putting DoEvents in the Refresh Data bit of code.

Try putting DoEvents in all of your loops.

 

[xenou]

Not really sure, but you do need to remove all the selection and active cell references. They don't belong in any kind of robust code and with so many lines of code to execute you can't cut corners on that. I also don't like turning off screen updating when I'm using selection and active cells references, since it weird to refer to where the cursor is at the moment and also tell Excel not to move the cursor around - I couldn't tell you if it should work or shouldn't work, but I've never done it that way.

Since you have calls to refresh queries, the behavior is less predictable. I'd do a refresh all at the beginning, removing that from the loops.