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: 1

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
PS... I have a code that executes this script when any value in column A from row 8 down changes.
 
Upvote 0

Forum statistics

Threads
1,214,932
Messages
6,122,332
Members
449,077
Latest member
jmsotelo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top