# Code needed for Max & Min Values

#### hsandeep

##### Well-known Member
I had mentioned earlier that you may need to re-think your design of this. If it were me, I would try to get rid of the situation where you have 13 copies of the code running simultaneously.
.
Will addition of below line in the code help to Run properly ‘part 2 of the problem’ in all the 13 Worksheets simultaneously?

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets(“Sheet1”)

### Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

#### Joe4

I doubt it, as Worksheet Event Procedures run on the sheet they are attached to by default, but you could always try it and see.

#### hsandeep

##### Well-known Member
I doubt it, as Worksheet Event Procedures run on the sheet they are attached to by default, but you could always try it and see.
Please EXTEND the existing code to perform the following 3 ADDITIONAL actions:

EARLIER action:
The code makes E2:F10 ‘grab’ MAXIMUM & MINIMUM (from B2:B10 when A1=1)

1. G2:G10 should get the FIRST OCCURRENCE (from B2:B10 when A1=1)
2. H2:H10 should get the LARGEST NUMBER THAT IS SMALLER THAN THE MAXIMUM NUMBER (from B2:B10 when A1=1)
3. I2:I10 should get the SMALLEST NUMBER THAT IS HIGHER THAN THE MINIMUM NUMBER (from B2:B10 when A1=1)

These ADDITIONAL actions ‘might’ be performed AFTER the EARLIER actions. What I mean the ADDITIONAL results may populate in the cells (G2:I10) before or after the EARLIER actions but the ‘EXTENDED’ code may be written SUBSEQUENT to the current code.

This would help me a lot Joe4.

#### Joe4

These are new questions. And I do not think I have the time to commit to something like this anyhow.
So you may be better off posting them to a new thread, or looking at get a Consultant to help you work through all your questions.

Last edited:

#### hsandeep

##### Well-known Member
See if those code update fixes your blank issue:
Code:
``````Private Sub Worksheet_Calculate()

Dim cell As Range

'   Exit if A1 not equal to 1
If Range("A1") <> 1 Then Exit Sub

Application.EnableEvents = False

'   Loop through range of values that is being updated
For Each cell In Range("B2:B10")
'       Check/update Maximum
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
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

Application.EnableEvents = True

End Sub``````
[/QUOTE]

I am regularly using your code in my Worksheet since many days now. It gives the desired results.

I have noticed that the code runs slow when triggered; in the manner that the calculated values by the macro get populated in the output 2D array E2:F42 is filled across & down one by one which can be seen easily.

Can the code be made faster?

#### hsandeep

##### Well-known Member
See if those code update fixes your blank issue:
Hope I am not making you tired. Unfortunately, I would suffer more if I do not communicate you & get some desired solution how to speed up the code.

Currently, every time VBA writes data to the worksheet, it refreshes the screen image by filling the output MAX:MIN range E2:F10 (my actual data range is larger E2:F42) so much slow that it takes 6-8 seconds approximately to fill it completely for every loop.

The output results are correct but the speed of populating the data is slow which is a considerable drag on the performance of macro & Worksheets dependent on the output MAX:MIN range E2:F10

However, if any cell is clicked, the speed of filling / updating the output MAX:MIN range E2:F10 is very fast.

Since the output MAX:MIN changes continuously, it is practically impossible to keep on clicking the Worksheet’s cell.

Last edited:

#### Joe4

Perhaps it will speed up some it you disable screen updates and calculations until the end of the code too:
Code:
``````Private Sub Worksheet_Calculate()

Dim cell As Range

'   Exit if A1 not equal to 1
If Range("A1") <> 1 Then Exit Sub

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

'   Loop through range of values that is being updated
For Each cell In Range("B2:B10")
'       Check/update Maximum
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
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

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

End Sub``````

#### hsandeep

##### Well-known Member
Currently, I have been using your code to get highest & lowest value occurred in C2:C42 whenever A1 is found 1.

I would like to bring to your kind attention that still the code is slow.

The worksheet contains numerous cells which are dependent on highest & lowest value occurred in C2:C42 & I think Excel recalculate each cells & thereby making the highest cells F2:F42 & lowest cells G2:G42 populate the results slowly.

The only scenario I can think of is (which you had suggested earlier) to bring all the 10 ‘similar’ worksheets in 1 Worksheet.

For this:

For 1st ws, A1 has been kept at A1, column C, F & G has been kept at C, F & G

2nd ws, for A1 has been kept at H1, column C, F & G has been kept at I, L & M

10th ws, for A1 has been kept at BD1, column C, F & G has been kept at BF, BI & BJ

I think this would speed the results which would be of immense help to my work.

Request you earnestly to consider it & provide the code.