dtarockoff
New Member
- Joined
- Jun 26, 2013
- Messages
- 24
Hi,
I'm currently working on a project in VBA where I need to write a sub that changes the font of the text in Column A for a given row based on meeting certain conditions. I've attached a picture of the worksheet I'm working with to make this easier to understand:
In column A, starting at A2 and down, I have a bunch of regions named Region#. In Columns B:M I have sales data for each month of the year for each particular region. What I want to do is write a Do Until Loop that checks each region's quarterly sales (Jan-March, April-June, July-Sept, and Oct-Dec) to see if there's a consistent upward or downward trend, and changes the font color of the region name in column A if it meets one of the conditions. If, for a given region, the quarterly sales consistently increase, I want the region name to be changed to red. For example, if the sum of cells B2:D2<E2:G2<H2:J2<K2:M2, I would change the font of cell A2 red. If they consistently decrease, I want the name to be blue. For example, if the sum of cells B2:D2>E2:G2>H2:J2>K2:M2, I would change the font of cell A2 blue. If there isn't a consistent trend, I just want the name to stay black. I need this code to work regardless of how many regions are added.
I've come up with an idea of how to write this but I'm having a lot of difficulty. This is what I'm currently trying (and it's clearly not working):
Dim TQ1 As Single
Dim TQ2 As Single
Dim TQ3 As Single
Dim TQ4 As Single
Dim i As Integer
i = 0
TQ1 = Range("B2").Offset(i, 0).Value + Range("C2").Offset(i, 0).Value + Range("D2").Offset(i, 0).Value
TQ2 = Range("E2").Offset(i, 0).Value + Range("F2").Offset(i, 0).Value + Range("G2").Offset(i, 0).Value
TQ3 = Range("H2").Offset(i, 0).Value + Range("I2").Offset(i, 0).Value + Range("J2").Offset(i, 0).Value
TQ4 = Range("K2").Offset(i, 0).Value + Range("L2").Offset(i, 0).Value + Range("M2").Offset(i, 0).Value
Do Until Range("A2").Offset(i, 0).Value = ""
TQ1 = Range("B2").Offset(i, 0).Value + Range("C2").Offset(i, 0).Value + Range("D2").Offset(i, 0).Value
TQ2 = Range("E2").Offset(i, 0).Value + Range("F2").Offset(i, 0).Value + Range("G2").Offset(i, 0).Value
TQ3 = Range("H2").Offset(i, 0).Value + Range("I2").Offset(i, 0).Value + Range("J2").Offset(i, 0).Value
TQ4 = Range("K2").Offset(i, 0).Value + Range("L2").Offset(i, 0).Value + Range("M2").Offset(i, 0).Value
If TQ1 < TQ2 < TQ3 < TQ4 Then
Range("A2").Offset(i, 0).Font.Color = vbRed
i = i + 1
ElseIf TQ4 < TQ3 < TQ2 < TQ1 Then
Range("A2").Offset(i, 0).Font.Color = vbBlue
i = i + 1
Else
Range("A2").Offset(i, 0).Font.Color = vbBlack
i = i + 1
End If
Loop
End Sub
I'd really appreciate any help - I'm pretty sure it's not working because the variables TQ1-TQ4 aren't resetting when the loop runs, but I don't know how to make it work. Thanks!
I'm currently working on a project in VBA where I need to write a sub that changes the font of the text in Column A for a given row based on meeting certain conditions. I've attached a picture of the worksheet I'm working with to make this easier to understand:

In column A, starting at A2 and down, I have a bunch of regions named Region#. In Columns B:M I have sales data for each month of the year for each particular region. What I want to do is write a Do Until Loop that checks each region's quarterly sales (Jan-March, April-June, July-Sept, and Oct-Dec) to see if there's a consistent upward or downward trend, and changes the font color of the region name in column A if it meets one of the conditions. If, for a given region, the quarterly sales consistently increase, I want the region name to be changed to red. For example, if the sum of cells B2:D2<E2:G2<H2:J2<K2:M2, I would change the font of cell A2 red. If they consistently decrease, I want the name to be blue. For example, if the sum of cells B2:D2>E2:G2>H2:J2>K2:M2, I would change the font of cell A2 blue. If there isn't a consistent trend, I just want the name to stay black. I need this code to work regardless of how many regions are added.
I've come up with an idea of how to write this but I'm having a lot of difficulty. This is what I'm currently trying (and it's clearly not working):
Dim TQ1 As Single
Dim TQ2 As Single
Dim TQ3 As Single
Dim TQ4 As Single
Dim i As Integer
i = 0
TQ1 = Range("B2").Offset(i, 0).Value + Range("C2").Offset(i, 0).Value + Range("D2").Offset(i, 0).Value
TQ2 = Range("E2").Offset(i, 0).Value + Range("F2").Offset(i, 0).Value + Range("G2").Offset(i, 0).Value
TQ3 = Range("H2").Offset(i, 0).Value + Range("I2").Offset(i, 0).Value + Range("J2").Offset(i, 0).Value
TQ4 = Range("K2").Offset(i, 0).Value + Range("L2").Offset(i, 0).Value + Range("M2").Offset(i, 0).Value
Do Until Range("A2").Offset(i, 0).Value = ""
TQ1 = Range("B2").Offset(i, 0).Value + Range("C2").Offset(i, 0).Value + Range("D2").Offset(i, 0).Value
TQ2 = Range("E2").Offset(i, 0).Value + Range("F2").Offset(i, 0).Value + Range("G2").Offset(i, 0).Value
TQ3 = Range("H2").Offset(i, 0).Value + Range("I2").Offset(i, 0).Value + Range("J2").Offset(i, 0).Value
TQ4 = Range("K2").Offset(i, 0).Value + Range("L2").Offset(i, 0).Value + Range("M2").Offset(i, 0).Value
If TQ1 < TQ2 < TQ3 < TQ4 Then
Range("A2").Offset(i, 0).Font.Color = vbRed
i = i + 1
ElseIf TQ4 < TQ3 < TQ2 < TQ1 Then
Range("A2").Offset(i, 0).Font.Color = vbBlue
i = i + 1
Else
Range("A2").Offset(i, 0).Font.Color = vbBlack
i = i + 1
End If
Loop
End Sub
I'd really appreciate any help - I'm pretty sure it's not working because the variables TQ1-TQ4 aren't resetting when the loop runs, but I don't know how to make it work. Thanks!