Next Loop with If, Elseif, Else executing slowly

kraestumpf

New Member
Joined
Dec 27, 2010
Messages
3
I am using VBA for a task list that formats text in cells based on a value in column A. Column A will have a number between 1 and 4 representing 4 different format styles. The code I created works but it is slow, and the length of time to execute the code increases the more rows I add to the task list. When I step through the code it seems to loop through each of the 12 Task lines I have in the test document, so that as I increase rows it increases the number of times it loops through.

Is there a better cleaner code that I can use that will execute whenever I make the level change in Column A without taking huge amounts of time as I add more and more tasks to the list?

GanttScreenShot.PNG


Sub WBS_Format()
Application.Calculation = xlCalculationManual
Const TEST_COLUMN As String = "C"
Dim LastRow As Long
Dim cell As Range
sSheetName = ActiveSheet.Name

With Worksheets(sSheetName)
LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row

For Each cell In Range("A8:A" & LastRow)
If cell.Value = 1 Then
cell.Offset(, 1).Resize(, 13).Interior.ColorIndex = 48
cell.Offset(, 1).Resize(, 13).Font.Size = 12
cell.Offset(, 1).Resize(, 13).Font.Bold = True
cell.Offset(, 1).Resize(, 13).Font.Italic = False
cell.Offset(, 1).Resize(, 13).IndentLevel = 0
ElseIf cell.Value = 2 Then
cell.Offset(, 1).Resize(, 13).Interior.ColorIndex = 2
cell.Offset(, 1).Resize(, 13).Font.Size = 10
cell.Offset(, 1).Resize(, 13).Font.Bold = True
cell.Offset(, 1).Resize(, 13).Font.Italic = False
cell.Offset(, 1).Resize(, 13).IndentLevel = 0
ElseIf cell.Value = 3 Then
cell.Offset(, 1).Resize(, 13).Interior.ColorIndex = 2
cell.Offset(, 1).Resize(, 13).Font.Size = 10
cell.Offset(, 1).Resize(, 13).Font.Italic = True
cell.Offset(, 1).Resize(, 13).Font.Bold = False
cell.Offset(, 3).Resize(, 1).IndentLevel = 1
cell.Offset(, 4).Resize(, 14).IndentLevel = 0
ElseIf cell.Value = 4 Then
cell.Offset(, 1).Resize(, 13).Interior.ColorIndex = 2
cell.Offset(, 1).Resize(, 13).Font.Size = 10
cell.Offset(, 1).Resize(, 13).Font.Italic = True
cell.Offset(, 1).Resize(, 13).Font.Bold = False
cell.Offset(, 3).Resize(, 1).IndentLevel = 2
cell.Offset(, 4).Resize(, 13).IndentLevel = 0
Else
cell.EntireRow.Interior.ColorIndex = xlNone
End If
Next
Application.Calculation = xlCalculationAutomatic
End With
End Sub
 

Attachments

  • GanttScreenShot.PNG
    GanttScreenShot.PNG
    41.6 KB · Views: 0

Some videos you may like

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

kraestumpf

New Member
Joined
Dec 27, 2010
Messages
3
PS... I have a code that executes this script when any value in column A from row 8 down changes.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,013
Messages
5,545,485
Members
410,685
Latest member
chandraganji
Top