Code to fill the highest & lowest value from a range in 2 ranges

hsandeep

Well-known Member
Joined
Dec 6, 2008
Messages
1,213
Office Version
  1. 2010
Platform
  1. Windows
  2. Mobile
Range C2:C17 updates using formula & changes its value very fast.

In F2:F17 the highest value occurred in the cells C2:C17 is filled in ‘RESPECTIVE/CORRESPONDING’ cells of F2:F17 when A1=1 else ‘nothing is filled’.
In G2:G17 the lowest value occurred in the cells C2:C17 is filled in ‘RESPECTIVE/CORRESPONDING’ cells of G2:G17 when A1=1 else ‘nothing is filled’.

For this I am using the below code successfully till large extent (although it is slow in execution)

Rich (BB code):
Private Sub Worksheet_Calculate()
'Code for Sheet H51
'Code checks/updates HIGHEST value occurred in C2:C16 & fills in F2:F16; C17 & fills in F17 when A1=1
'Code checks/updates LOWEST value occurred in C2:C3 & fills in G2:G16; C17 & fills in G17 when A1=1
Dim cell As Range
'Exit if A1 is not equal to 1
If Range("A1") <> 1 Then Exit Sub

'Loop through range of values that is being updated in C2:C16 & C17
For Each cell In Range("C2:C17")

'Check/update Maximum HIGHEST Value occurred in C2:C16 and FILL it in F2:F16; C17 in F17
If (Len(cell.Offset(0, 3)) > 0) And (IsNumeric(cell.Offset(0, 3))) Then
If cell > cell.Offset(0, 3) Then cell.Offset(0, 3) = cell
Else
cell.Offset(0, 3) = cell
End If

'Check/update Minimum LOWEST Value occurred in C2:C16 and FILL it in G2:G16; C17 in G17
If (Len(cell.Offset(0, 4)) > 0) And (IsNumeric(cell.Offset(0, 4))) Then
If cell < cell.Offset(0, 4) Then cell.Offset(0, 4) = cell
Else
cell.Offset(0, 4) = cell
End If
Next cell
End Sub

Book2.xlsx
ABCDEFG
10ValueValue HIGHESTValue LOWEST
21140.10
31042.15
4942.35
5850.00
6759.95
7665.55
8579.45
9498.25
10422.00
11348.00
12283.85
13227.00
14177.95
15133.60
16100.65
1743233.90
H51


I want a new code to ADD the below action.
Range M2:M17 updates using formula & changes its value very fast. (in the same worksheet)

In P2:P17 the highest value occurred in the cells M2:M17 SHOULD BE FILLED in ‘RESPECTIVE/CORRESPONDING’ cells of P2:P17 when K1=1 else ‘nothing should be filled’.
In Q2:Q17 the lowest value occurred in the cells M2:M17 SHOULD BE FILLED in ‘RESPECTIVE/CORRESPONDING’ cells of Q2:Q17 when K1=1 else ‘nothing should be filled’.
Book2.xlsx
ABCDEFGHIJKLMNOPQ
10ValueValue HIGHESTValue LOWEST0ValueValue HIGHESTValue LOWEST
21140.101140.10
31042.151042.15
4942.35942.35
5850.00850.00
6759.95759.95
7665.55665.55
8579.45579.45
9498.25498.25
10422.00422.00
11348.00348.00
12283.85283.85
13227.00227.00
14177.95177.95
15133.60133.60
16100.65100.65
1743233.9043233.90
H51


Thanks in advance.
 
Oh sorry,

Try to change this line:
VBA Code:
For r = 2 To UBound(myRange, 2)
Like this:
VBA Code:
For r = 2 To UBound(myRange, 1)
No. It worked different actions. I changed ONLY C2 to a new value (replacing the old value which was present in C2) by mannual punching. Your Code filled
Even F3:F16 & G3:G16 even though there was no change in C3:C16.!!!
The values in F2:F16 & G2:G16 are wrongly filled...some wrong filling instructions in the code might have done this.
The output looks like (WRONG)
Book22.xlsx
ABCDEFG
11LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame
2421001300.0043233.90100.65
3422001100.001300.00133.60
442300950.001100.00177.95
542400850.00950.00227.00
642500759.95850.00283.85
742600665.55759.95348.00
842700579.45665.55422.00
942800498.25579.45498.25
1042900422.00498.25579.45
1143000348.00422.00665.55
1243100283.85348.00759.95
1343200227.00283.85850.00
1443300177.95227.00950.00
1543400133.60177.951100.00
1643500100.65133.601300.00
1743233.90100.6543233.90
Sheet1
 
Upvote 0

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Ok, I tought you wanted to sort from low to high. Can you share a result example and explain the logic? I didn't understand the logic in column B.
 
Upvote 0
Ok, I tought you wanted to sort from low to high. Can you share a result example and explain the logic? I didn't understand the logic in column B.
@Flashbond
I’ll try to explain:

  1. Code should do nothing with column B.​
  2. C2:C16 updates using formula & changes its value very fast. (in the same worksheet). Speed of updating is approximately 3 values per second i.e. IF C2=1100.00 it can get changed to 1200.00; 1150.00; 1225.35.​
  3. Code has to check whether A1=1 & then perform its action on C2:C16.​
  4. When A1=1, consider C2, in isolation, IF C2=1100.00 it gets changed to 1200.00; 1050.00; 1225.35.; the code should start filling F2 & G2 as follows:​
  5. First, F2=1100.00 & G2=1100.00 since these are the highest & lowest value occurred, so far, in C2.​
    • Then, F2 should get changed to 1200.00 (since now 1200.00 is the highest value, so far, occurred in C2) & G2 remains=1100.00
    • Then, F2 should remain 1200.00 & G2 should get changed to 1050.00 (since now 1050.00 is the lowest value occurred, so far, in C2).
    • Then F2 should get changed to 1225.35 (since now 1225.35 is the highest value, so far, occurred in C2) & G2 remains=1050.00
  6. Similarly for rest C3:C16 IF A1=1​
  7. Now IF A1 becomes 0 (from 1), code should STOP changing F2:F16 & G2:G16​
  8. Similarly, IF K1=1, same actions should be performed by the code. Check values of M2:M16, start filling in P2:P16 & Q2:Q16 as per above example described. & finally stop filling P2:P16 & Q2:Q16 when K1 becomes 0 (from 1).​
  9. Similarly till DG1:DM16. Check DG1=1 or not, fill DL2:DL16 & DM2:DM16 & stop filling DL2:DL16 & DM2:DM16 when DG1 becomes 0 (from 1).​
Book22.xlsx
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZBABBBCBDBEBFBGBHBIBJBKBLBMBNBOBPBQBRBSBTBUBVBWBXBYBZCACBCCCDCECFCGCHCICJCKCLCMCNCOCPCQCRCSCTCUCVCWCXCYCZDADBDCDDDEDFDGDHDIDJDKDLDM
11LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame
21300.0043233.90100.650777.000777.000777.000777.000777.000777.000777.000777.000777.000777.000777.00
31100.001300.00133.60888.00888.00888.00888.00888.00888.00888.00888.00888.00888.00888.00
4950.001100.00177.9599.0099.0099.0099.0099.0099.0099.0099.0099.0099.0099.00
5850.00950.00227.0043033.0043033.0043033.0043033.0043033.0043033.0043033.0043033.0043033.0043033.0043033.00
6759.95850.00283.8542853.0042853.0042853.0042853.0042853.0042853.0042853.0042853.0042853.0042853.0042853.00
7665.55759.95348.0043088.0043088.0043088.0043088.0043088.0043088.0043088.0043088.0043088.0043088.0043088.00
8579.45665.55422.0010.0010.0010.0010.0010.0010.0010.0010.0010.0010.0010.00
9498.25579.45498.2543224.0043224.0043224.0043224.0043224.0043224.0043224.0043224.0043224.0043224.0043224.00
10422.00498.25579.4542754.9542754.9542754.9542754.9542754.9542754.9542754.9542754.9542754.9542754.9542754.95
11348.00422.00665.5520.0020.0020.0020.0020.0020.0020.0020.0020.0020.0020.00
12283.85348.00759.9543091.0043091.0043091.0043091.0043091.0043091.0043091.0043091.0043091.0043091.0043091.00
13227.00283.85850.0043154.9543154.9543154.9543154.9543154.9543154.9543154.9543154.9543154.9543154.9543154.95
14177.95227.00950.0030.0030.0030.0030.0030.0030.0030.0030.0030.0030.0030.00
15133.60177.951100.0043230.0043230.0043230.0043230.0043230.0043230.0043230.0043230.0043230.0043230.0043230.00
16100.65133.601300.0040.0040.0040.0040.0040.0040.0040.0040.0040.0040.0040.00
Sheet1
 
Last edited:
Upvote 0
@Flashbond
I’ll try to explain:

  1. Code should do nothing with column B.​
  2. C2:C16 updates using formula & changes its value very fast. (in the same worksheet). Speed of updating is approximately 3 values per second i.e. IF C2=1100.00 it can get changed to 1200.00; 1150.00; 1225.35.​
  3. Code has to check whether A1=1 & then perform its action on C2:C16.​
  4. When A1=1, consider C2, in isolation, IF C2=1100.00 it gets changed to 1200.00; 1050.00; 1225.35.; the code should start filling F2 & G2 as follows:​
  5. First, F2=1100.00 & G2=1100.00 since these are the highest & lowest value occurred, so far, in C2.​
    • Then, F2 should get changed to 1200.00 (since now 1200.00 is the highest value, so far, occurred in C2) & G2 remains=1100.00
    • Then, F2 should remain 1200.00 & G2 should get changed to 1050.00 (since now 1050.00 is the lowest value occurred, so far, in C2).
    • Then F2 should get changed to 1225.35 (since now 1225.35 is the highest value, so far, occurred in C2) & G2 remains=1050.00
  6. Similarly for rest C3:C16 IF A1=1​
  7. Now IF A1 becomes 0 (from 1), code should STOP changing F2:F16 & G2:G16​
  8. Similarly, IF K1=1, same actions should be performed by the code. Check values of M2:M16, start filling in P2:P16 & Q2:Q16 as per above example described. & finally stop filling P2:P16 & Q2:Q16 when K1 becomes 0 (from 1).​
  9. Similarly till DG1:DM16. Check DG1=1 or not, fill DL2:DL16 & DM2:DM16 & stop filling DL2:DL16 & DM2:DM16 when DG1 becomes 0 (from 1).​
Book22.xlsx
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZBABBBCBDBEBFBGBHBIBJBKBLBMBNBOBPBQBRBSBTBUBVBWBXBYBZCACBCCCDCECFCGCHCICJCKCLCMCNCOCPCQCRCSCTCUCVCWCXCYCZDADBDCDDDEDFDGDHDIDJDKDLDM
11LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame0LTP of CALL LTP Current Time FrameCALL LTP High of Current Time FrameCALL LTP Low of Current Time Frame
21300.0043233.90100.650777.000777.000777.000777.000777.000777.000777.000777.000777.000777.000777.00
31100.001300.00133.60888.00888.00888.00888.00888.00888.00888.00888.00888.00888.00888.00
4950.001100.00177.9599.0099.0099.0099.0099.0099.0099.0099.0099.0099.0099.00
5850.00950.00227.0043033.0043033.0043033.0043033.0043033.0043033.0043033.0043033.0043033.0043033.0043033.00
6759.95850.00283.8542853.0042853.0042853.0042853.0042853.0042853.0042853.0042853.0042853.0042853.0042853.00
7665.55759.95348.0043088.0043088.0043088.0043088.0043088.0043088.0043088.0043088.0043088.0043088.0043088.00
8579.45665.55422.0010.0010.0010.0010.0010.0010.0010.0010.0010.0010.0010.00
9498.25579.45498.2543224.0043224.0043224.0043224.0043224.0043224.0043224.0043224.0043224.0043224.0043224.00
10422.00498.25579.4542754.9542754.9542754.9542754.9542754.9542754.9542754.9542754.9542754.9542754.9542754.95
11348.00422.00665.5520.0020.0020.0020.0020.0020.0020.0020.0020.0020.0020.00
12283.85348.00759.9543091.0043091.0043091.0043091.0043091.0043091.0043091.0043091.0043091.0043091.0043091.00
13227.00283.85850.0043154.9543154.9543154.9543154.9543154.9543154.9543154.9543154.9543154.9543154.9543154.95
14177.95227.00950.0030.0030.0030.0030.0030.0030.0030.0030.0030.0030.0030.00
15133.60177.951100.0043230.0043230.0043230.0043230.0043230.0043230.0043230.0043230.0043230.0043230.0043230.00
16100.65133.601300.0040.0040.0040.0040.0040.0040.0040.0040.0040.0040.0040.00
Sheet1
I would like to summarize the 2 actions needed by the code to perform.
1st Action that should be performed by the code:

As soon as A1 becomes equal to 1 (from 0), F2=C2 & G2=C2
Similarly, when K1=1, P2=M2 & Q2=M2
Similarly, when U1=1, Z2=W2 & AA2=W.
Similarly, when AE1=1, AJ2=AG2 & AK2=AG2
Similarly, when AO1=1, AT2=AQ2 & AU2=AQ2
Similarly, when AY1=1, BD2=BA2 & BE2=BA2
Similarly, when BI1=1, BN2=BK2 & BO2=BK2
Similarly, when BS1=1, BX2=BU2 & BY2=BU2
Similarly, when CC1=1, CH2=CE2 & CI2=CH2
Similarly, when CM1=1, CR2=CO2 & CS2=CO2
Similarly, when CW1=1, DB2=CY2 & DC2=CY2
Similarly, when DG1=1, DL2=DI2 & DM2=DI2

2nd Action: When A1=1, check if the updated value in each cells of C is the highest or lowest value encountered so far in that specific cell. If the updated value is the highest value, the code should update the corresponding cell in column F with that value. It should compare the updated value with the current value in column F for that cell and replace it if the updated value is higher. However, If the updated value is the lowest value, the code should update the corresponding cell in column G with that value. It should compare the updated value with the current value in column G for that cell and replace it if the updated value is lower.

Similar 2nd Action should be enhanced to the balance 11 ranges.
 
Upvote 0
I would like to summarize the 2 actions needed by the code to perform.
1st Action that should be performed by the code:

As soon as A1 becomes equal to 1 (from 0), F2=C2 & G2=C2
Similarly, when K1=1, P2=M2 & Q2=M2
Similarly, when U1=1, Z2=W2 & AA2=W.
Similarly, when AE1=1, AJ2=AG2 & AK2=AG2
Similarly, when AO1=1, AT2=AQ2 & AU2=AQ2
Similarly, when AY1=1, BD2=BA2 & BE2=BA2
Similarly, when BI1=1, BN2=BK2 & BO2=BK2
Similarly, when BS1=1, BX2=BU2 & BY2=BU2
Similarly, when CC1=1, CH2=CE2 & CI2=CH2
Similarly, when CM1=1, CR2=CO2 & CS2=CO2
Similarly, when CW1=1, DB2=CY2 & DC2=CY2
Similarly, when DG1=1, DL2=DI2 & DM2=DI2

2nd Action: When A1=1, check if the updated value in each cells of C is the highest or lowest value encountered so far in that specific cell. If the updated value is the highest value, the code should update the corresponding cell in column F with that value. It should compare the updated value with the current value in column F for that cell and replace it if the updated value is higher. However, If the updated value is the lowest value, the code should update the corresponding cell in column G with that value. It should compare the updated value with the current value in column G for that cell and replace it if the updated value is lower.

Similar 2nd Action should be enhanced to the balance 11 ranges.
I have written a code for above actions to be performed by the code. BUT IT DOESN'T WORKS. CAN SOMEONE HELP FROM THIS FORUM SO THAT THE CODE PERFORMS THE ACTIONS REQUIRED?
Rich (BB code):
Private Sub Worksheet_Calculate()
    UpdateMaxMin
End Sub
Sub UpdateMaxMin()
    Dim dataC As Variant, dataM As Variant, dataW As Variant, dataAE As Variant, dataAO As Variant, dataAY As Variant, dataBI As Variant, dataBS As Variant, dataCC As Variant, dataCM As Variant, dataCW As Variant, dataDG As Variant
    Dim i As Long

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim checkCells As Variant, cell As Variant
    
        checkCells = Array("A1", "K1", "U1", "AE1", "AO1", "AY1", "BI1", "BS1", "CC1", "CM1", "CW1")
            For Each cell In checkCells
                If Range(cell).Value = 1 Then
            Exit For
                End If
            Next cell
                If cell Is Nothing Then
                    Exit Sub
                End If
                
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    If Range("A1").Value = 1 Then
        Dim arrDataC As Variant
            arrDataC = Union(Range("C2:C17"), Range("C2:C17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataC, 1) To UBound(arrDataC, 1)
                    If arrDataC(i, 4) = 0 Or arrDataC(i, 1) > arrDataC(i, 4) Then
                        arrDataC(i, 4) = arrDataC(i, 1)
                End If
                    If arrDataC(i, 5) = 0 Or arrDataC(i, 1) < arrDataC(i, 5) Then
                        arrDataC(i, 5) = arrDataC(i, 1)
                End If
            Next i

            Range("F2:G17").Value = arrDataC
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("K1").Value = 1 Then
        Dim arrDataK As Variant
            arrDataK = Union(Range("M2:M17"), Range("M2:M17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataK, 1) To UBound(arrDataK, 1)
                    If arrDataK(i, 4) = 0 Or arrDataK(i, 1) > arrDataK(i, 4) Then
                        arrDataK(i, 4) = arrDataK(i, 1)
                End If
                    If arrDataK(i, 5) = 0 Or arrDataK(i, 1) < arrDataK(i, 5) Then
                        arrDataK(i, 5) = arrDataK(i, 1)
                End If
            Next i

            Range("P2:Q17").Value = arrDataK
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("U1").Value = 1 Then
        Dim arrDataU As Variant
            arrDataU = Union(Range("W2:W17"), Range("W2:W17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataU, 1) To UBound(arrDataU, 1)
                    If arrDataU(i, 4) = 0 Or arrDataU(i, 1) > arrDataU(i, 4) Then
                        arrDataU(i, 4) = arrDataU(i, 1)
                End If
                    If arrDataU(i, 5) = 0 Or arrDataU(i, 1) < arrDataU(i, 5) Then
                        arrDataU(i, 5) = arrDataU(i, 1)
                End If
            Next i

            Range("Z2:AA17").Value = arrDataU
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("AE1").Value = 1 Then
        Dim arrDataAE As Variant
            arrDataAE = Union(Range("AG2:AG17"), Range("AG2:AG17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataAE, 1) To UBound(arrDataAE, 1)
                    If arrDataAE(i, 4) = 0 Or arrDataAE(i, 1) > arrDataAE(i, 4) Then
                        arrDataAE(i, 4) = arrDataAE(i, 1)
                End If
                    If arrDataAE(i, 5) = 0 Or arrDataAE(i, 1) < arrDataAE(i, 5) Then
                        arrDataAE(i, 5) = arrDataAE(i, 1)
                End If
            Next i

            Range("AJ2:AK17").Value = arrDataAE
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("AO1").Value = 1 Then
        Dim arrDataAO As Variant
            arrDataAO = Union(Range("AQ2:AQ17"), Range("AQ2:AQ17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataAO, 1) To UBound(arrDataAO, 1)
                    If arrDataAO(i, 4) = 0 Or arrDataAO(i, 1) > arrDataAO(i, 4) Then
                        arrDataAO(i, 4) = arrDataAO(i, 1)
                End If
                    If arrDataAO(i, 5) = 0 Or arrDataAO(i, 1) < arrDataAO(i, 5) Then
                        arrDataAO(i, 5) = arrDataAO(i, 1)
                End If
            Next i

            Range("AT2:AU17").Value = arrDataAO
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("AY1").Value = 1 Then
        Dim arrDataAY As Variant
            arrDataAY = Union(Range("BA2:BA17"), Range("BA2:BA17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataAY, 1) To UBound(arrDataAY, 1)
                    If arrDataAY(i, 4) = 0 Or arrDataAY(i, 1) > arrDataAY(i, 4) Then
                        arrDataAY(i, 4) = arrDataAY(i, 1)
                End If
                    If arrDataAY(i, 5) = 0 Or arrDataAY(i, 1) < arrDataAY(i, 5) Then
                        arrDataAY(i, 5) = arrDataAY(i, 1)
                End If
            Next i

            Range("BD2:BE17").Value = arrDataAY
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("BI1").Value = 1 Then
        Dim arrDataBI As Variant
            arrDataBI = Union(Range("BK2:BK17"), Range("BK2:BK17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataBI, 1) To UBound(arrDataBI, 1)
                    If arrDataBI(i, 4) = 0 Or arrDataBI(i, 1) > arrDataBI(i, 4) Then
                        arrDataBI(i, 4) = arrDataBI(i, 1)
                End If
                    If arrDataBI(i, 5) = 0 Or arrDataBI(i, 1) < arrDataBI(i, 5) Then
                        arrDataBI(i, 5) = arrDataBI(i, 1)
                End If
            Next i

            Range("BN2:BO17").Value = arrDataBI
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("BS1").Value = 1 Then
        Dim arrDataBS As Variant
            arrDataBS = Union(Range("BU2:BU17"), Range("BU2:BU17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataBS, 1) To UBound(arrDataBS, 1)
                    If arrDataBS(i, 4) = 0 Or arrDataBS(i, 1) > arrDataBS(i, 4) Then
                        arrDataBS(i, 4) = arrDataBS(i, 1)
                End If
                    If arrDataBS(i, 5) = 0 Or arrDataBS(i, 1) < arrDataBS(i, 5) Then
                        arrDataBS(i, 5) = arrDataBS(i, 1)
                End If
            Next i

            Range("BX2:BY17").Value = arrDataBS
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("CC1").Value = 1 Then
        Dim arrDataCC As Variant
            arrDataCC = Union(Range("CE2:CE17"), Range("CE2:CE17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataCC, 1) To UBound(arrDataCC, 1)
                    If arrDataCC(i, 4) = 0 Or arrDataCC(i, 1) > arrDataCC(i, 4) Then
                        arrDataCC(i, 4) = arrDataCC(i, 1)
                End If
                    If arrDataCC(i, 5) = 0 Or arrDataCC(i, 1) < arrDataCC(i, 5) Then
                        arrDataCC(i, 5) = arrDataCC(i, 1)
                End If
            Next i

            Range("CH2:CI17").Value = arrDataCC
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("CM1").Value = 1 Then
        Dim arrDataCM As Variant
            arrDataCM = Union(Range("CO2:CO17"), Range("CO2:CO17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataCM, 1) To UBound(arrDataCM, 1)
                    If arrDataCM(i, 4) = 0 Or arrDataCM(i, 1) > arrDataCM(i, 4) Then
                        arrDataCM(i, 4) = arrDataCM(i, 1)
                End If
                    If arrDataCM(i, 5) = 0 Or arrDataCM(i, 1) < arrDataCM(i, 5) Then
                        arrDataCM(i, 5) = arrDataCM(i, 1)
                End If
            Next i

            Range("CR2:CS17").Value = arrDataCM
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("CW1").Value = 1 Then
        Dim arrDataCW As Variant
            arrDataCW = Union(Range("CY2:CY17"), Range("CY2:CY17").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataCW, 1) To UBound(arrDataCW, 1)
                    If arrDataCW(i, 4) = 0 Or arrDataCW(i, 1) > arrDataCW(i, 4) Then
                        arrDataCW(i, 4) = arrDataCW(i, 1)
                End If
                    If arrDataCW(i, 5) = 0 Or arrDataCW(i, 1) < arrDataCW(i, 5) Then
                        arrDataCW(i, 5) = arrDataCW(i, 1)
                End If
            Next i

            Range("DB2:DC17").Value = arrDataCW
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    

    Application.EnableEvents = False
    Application.ScreenUpdating = False

    If Range("DG1").Value = 1 Then
        Dim arrDataDG As Variant
            arrDataDG = Union(Range("DI2:DI18"), Range("DI2:DI18").Offset(0, 3).Resize(, 2)).Value

            For i = LBound(arrDataDG, 1) To UBound(arrDataDG, 1)
                    If arrDataDG(i, 4) = 0 Or arrDataDG(i, 1) > arrDataDG(i, 4) Then
                        arrDataDG(i, 4) = arrDataDG(i, 1)
                End If
                    If arrDataDG(i, 5) = 0 Or arrDataDG(i, 1) < arrDataDG(i, 5) Then
                        arrDataDG(i, 5) = arrDataDG(i, 1)
                End If
            Next i

            Range("DL2:DM18").Value = arrDataDG
    End If

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic 

End Sub
 
Upvote 0

Forum statistics

Threads
1,215,132
Messages
6,123,227
Members
449,091
Latest member
jeremy_bp001

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