2. Write a sub that examines each region\'s quarterly sales fluctuation. For eac
ID: 3557205 • Letter: 2
Question
2. Write a sub that examines each region's quarterly sales fluctuation. For each region, if the sales increase consecutively for 3 quarters, color the regeion label green; if the sales decrease consecutively for 3 quarters, color the region label red.
The worksheet "Sales" contains monthly sales amounts across 40 regions. 1. Write a sub that colors the interior of every other row (rows 3, 5, etc.) gray. Be noticed, only color the data area.2. Write a sub that examines each region's quarterly sales fluctuation. For each region, if the sales increase consecutively for 3 quarters, color the regeion label green; if the sales decrease consecutively for 3 quarters, color the region label red.
Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec Region 1 13531 7014 5678 13589 5357 8169 8907 14055 5751 5254 13383 9445 Region 2 14399 8438 11724 14419 7854 5005 7679 14472 11185 7053 13263 13913 Region 3 9118 14837 6229 6826 10611 8652 6725 14304 12708 8687 10696 6824 Region 4 5680 14382 8143 12194 13596 9343 13795 14087 9826 14107 12550 14945 Region 5 8511 7202 12166 14547 12145 12095 10812 9329 9375 11046 9954 11194 Region 6 11438 14922 8586 9590 14748 8338 12141 9007 11647 5647 8972 10431 Region 7 5089 8035 10394 12279 13571 13288 6021 9244 7508 9103 5938 14306 Region 8 13322 10581 14055 8118 5156 10260 14481 8532 6871 5282 8692 13436 Region 9 9324 5997 8536 14864 14892 13231 6601 11043 5209 12439 12237 9875 Region 10 6485 8434 10843 13809 9517 13962 12928 10607 10149 11697 10194 9934 Region 11 8712 5087 9580 10023 13184 7467 11559 5650 10163 5349 8428 7101 Region 12 11725 8227 14551 10941 9166 10904 12369 12897 9152 12908 8830 8087 Region 13 14101 9371 9974 8310 11616 14094 11999 9877 13700 10845 14601 10362 Region 14 12234 13536 10785 14097 9013 13585 6092 9401 12778 10259 11825 8382 Region 15 6424 14854 11627 6406 5920 13635 5980 8475 7053 8021 7691 11656 Region 16 11916 11230 13903 10275 12882 8879 6058 13853 14637 6327 14499 12195 Region 17 12222 8437 13466 13237 6870 11955 9473 14582 7667 10844 14414 8232 Region 18 12630 8083 10381 13143 11680 7930 11795 12699 6347 7279 10179 9856 Region 19 10930 9680 11159 9104 12177 12418 9918 10555 10359 14040 12024 5406 Region 20 8722 11606 12747 8622 12068 9321 11350 7182 11096 12986 9163 8781 Region 21 5788 8192 10351 10506 12646 6584 13702 9667 11578 5154 7128 11393 Region 22 13578 7965 6297 14850 6040 10949 9339 14645 11946 7943 8623 11278 Region 23 10342 12582 12354 5558 8737 6618 5045 6490 7903 8546 10475 5427 Region 24 10016 6307 8748 5944 7026 13039 12108 12322 11267 5101 13896 11518 Region 25 9306 13890 11957 6789 10989 10877 12508 12848 12225 12388 12351 13019 Region 26 10849 10633 12150 9581 8441 10601 12654 9851 13106 11420 6744 8551 Region 27 13255 7948 12879 12091 9481 9735 5775 9651 5364 12635 9356 8825 Region 28 13022 12090 6620 12344 7452 14219 11494 13387 8576 5308 9504 8435 Region 29 11410 5631 6134 14572 13445 6600 13143 5637 6544 10489 9484 8217 Region 30 6609 6186 14997 5029 12149 13334 11339 6580 12126 14528 8359 13257 Region 31 8489 12704 12481 8855 7373 13974 5466 6568 10004 11261 11451 6059 Region 32 7447 5682 9049 10196 11922 14277 14552 6201 13081 5925 12113 8649 Region 33 9140 6709 7454 5490 9904 9914 8181 6481 7775 12255 7324 8696 Region 34 7807 6289 8588 13829 7871 9770 12219 10512 11935 5915 8487 8524 Region 35 8629 10103 8539 8637 10819 11523 6730 10701 13790 9633 11090 8599 Region 36 9608 10997 11092 9813 11016 13202 12119 6518 10483 6314 11726 14547 Region 37 6675 12171 12561 5687 5345 8435 10842 6473 12426 9992 14593 14752 Region 38 5566 5313 14454 14983 14732 6365 7176 11148 5068 12832 8652 11889 Region 39 14948 5990 6483 9544 5775 7636 6387 8770 13074 13610 14817 13794 Region 40 12316 14217 8572 8309 14346 12840 11462 5958 12277 8871 9376 7313Explanation / Answer
'part 1
Sub OddColorBackground()
Dim lrow As Long
lrow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).row
For r = 2 To lrow
If (r Mod 2) = 1 Then
ActiveSheet.Cells(r, 1).EntireRow.Interior.Color = RGB(192, 192, 192)
End If
Next r
End Sub
'part 2
Function QuarterlyAnalysis(row As Integer) As Integer
Dim col As Integer, ni As Integer, nd As Integer, fluct_str As String
fluct_string = ""
ni = 0
nd = 0
col = 1
While col < 8
If ActiveSheet.Cells(row, (col + 1)).Value > ActiveSheet.Cells(row, (col + 4)).Value Then
fluct_string = fluct_string + "d"
ElseIf ActiveSheet.Cells(row, (col + 1)).Value < ActiveSheet.Cells(row, (col + 4)).Value Then
fluct_string = fluct_string + "i"
End If
col = col + 3
Wend
If InStr(fluct_string, "iii") Then
QuarterlyAnalysis = 1
ElseIf InStr(fluct_string, "ddd") Then
QuarterlyAnalysis = -1
Else
QuarterlyAnalysis = 0
End If
End Sub
Sub QuarterlyColor()
Dim lrow As Long, r As Integer
lrow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).row
For r = 2 To lrow
If QuarterlyAnalysis(r) = 1 Then
ActiveSheet.Cells(r, 1).Interior.Color = RGB(0, 255, 0)
ElseIf QuarterlyAnalysis(r) = -1 Then
ActiveSheet.Cells(r, 1).Interior.Color = RGB(255, 0, 0)
End If
Next r
End Sub
Related Questions
drjack9650@gmail.com
Navigate
Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.