TrainingExcellence
New Member
- Joined
- Apr 6, 2017
- Messages
- 10
- Office Version
- 365
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?
Thanks!
Ben
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?
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