A hat store intents to make a Black Friday sales promotion. However, before lowering the prices, the store manager decides to adjust the prices up so the given discounts will not reduce the store's margin of sales by much. To do that, he decided that he would follow the following rules:
After these adjustments are applied, he decided that the Black Friday's discounts should be:
The hat store manager has given you the task to calculate the final discount price of the products and to compare it with their original values. The items that actually had their prices lowered by the store's "discount" should be colored green.
Solved Exercise
Exercise Solution
Initially, we apply to each product the first price adjustment (price increment) in accordance to the rules stated by the exercise

We start by declaring the variables and finding the last data entry in the worksheet
Dim LastRow As Long
Dim i As Integer
Dim AdJust As Variant
Dim DisCou As Variant
LastRow = Cells(Rows.Count, 2).End(xlUp).Row

Then we create a For Next loop that will run until the last entry and we assign this loop to a Select Case statement in order to calculate the incremented prices.
For i = 3 To LastRow
Select Case Cells(i, 2).Value
Case 6 To 15
AdJust = 0.15
Cells(i, 3).Value = Cells(i, 2).Value * AdJust
Case 15.01 To 25
AdJust = 0.25
Cells(i, 3).Value = Cells(i, 2).Value * AdJust
Case Is > 25.01
AdJust = 0.35
Cells(i, 3).Value = Cells(i, 2).Value * AdJust
End Select

We can also calculate the discount prices in the same loop since we already assigned cells to calculate the incremented prices in the worksheet.
Select Case Cells(i, 4).Value
Case 6 To 15
DisCou = 0.1
Cells(i, 5).Value = Cells(i, 4).Value * DisCou
Case 15.01 To 22
DisCou = 0.175
Cells(i, 5).Value = Cells(i, 4).Value * DisCou
Case 22.01 To 33
DisCou = 0.25
Cells(i, 5).Value = Cells(i, 4).Value * DisCou
Case Is > 33.01
DisCou = 0.3
Cells(i, 5).Value = Cells(i, 4).Value * DisCou
End Select

Finally, we create a conditional to access if the discount price is actually a lowered price value. If this is true, we color the cell background green.
If Cells(i, 7).Value < Cells(i, 2).Value Then
Cells(i, 7).Interior.Color = RGB(140, 198, 63)
End If
Next i
Consolidated Answer
Sub Solution()
Dim LastRow As Long
Dim i As Integer
Dim AdJust As Variant
Dim DisCou As Variant
LastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 3 To LastRow
Select Case Cells(i, 2).Value
Case 6 To 15
AdJust = 0.15
Cells(i, 3).Value = Cells(i, 2).Value * AdJust
Case 15.01 To 25
AdJust = 0.25
Cells(i, 3).Value = Cells(i, 2).Value * AdJust
Case Is > 25.01
AdJust = 0.35
Cells(i, 3).Value = Cells(i, 2).Value * AdJust
End Select
Select Case Cells(i, 4).Value
Case 6 To 15
DisCou = 0.1
Cells(i, 5).Value = Cells(i, 4).Value * DisCou
Case 15.01 To 22
DisCou = 0.175
Cells(i, 5).Value = Cells(i, 4).Value * DisCou
Case 22.01 To 33
DisCou = 0.25
Cells(i, 5).Value = Cells(i, 4).Value * DisCou
Case Is > 33.01
DisCou = 0.3
Cells(i, 5).Value = Cells(i, 4).Value * DisCou
End Select
If Cells(i, 7).Value < Cells(i, 2).Value Then
Cells(i, 7).Interior.Color = RGB(140, 198, 63)
End If
Next i
End Sub
SuperExcelVBA.com is learning website. Examples might be simplified to improve reading and basic understanding. Tutorials, references, and examples are constantly reviewed to avoid errors, but we cannot warrant full correctness of all content. All Rights Reserved.
Excel ® is a registered trademark of the Microsoft Corporation.
© 2023 SuperExcelVBA  ABOUT