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?
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
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?
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