# Find column with max value

Hello Experts,

I need to start to my code from the Sheet.activate.  I need to do this in vb since I have other code to add later, I want to avoid setting this up in the Excel sheet.

I need to find the column with the highest max value from range ("AG4:AK4") and then have have column +1.value to equal 50.

If you could guide me along with the next step too - it would be very helpful.  The next step would be if AG5 = 50 then 'do this, if AH5 = 50 then 'do this etc etc.

I have tried numerous things but keep getting errors from object not set to other issues.  I have given up and have turned to you guys.

thanks
###### Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Author Commented:
Experts,

I need to clarify a step - I need to reference back to the cell in the range that has the highest max value.

I stated earlier that I need to reference to the cell in row 5 that now equals 50 - that is incorrect, I need to add additional code from the cell that is identified from the range("AG4:AK4") .

This is where I need help with the 2nd step is how to reference that cell that has the max value and then do my additonal coding.

Step 1- is to have the max range cell add 50 to the next cell down.
Step 2 - write additional steps of code based off the position of the max range cell.

Thanks Experts.
Commented:
Here's one way, if you have one to many rows to examine:
``````Private Sub Worksheet_Activate()
Dim r As Range
Dim rng As Range
Dim rMaxRange As Range
Dim maxVal As Double 'assuming numeric values
Dim rNextCellDown As Range

Set rng = Range("AG4:AK4")

For Each r In rng
If r.Value > maxVal Then
maxVal = r.Value
Set rMaxRange = r
End If
Next r

If maxVal > 0 Then
'add 50 to the next cell down
Set rNextCellDown = rMaxRange.Offset(1, 0)
rNextCellDown.Value = rNextCellDown.Value + 50
End If

End Sub
``````

And, if you're just working one row, the Evaluate of the MATCH(MAX function should work and be pretty efficient at it:
``````Private Sub Worksheet_Activate()
Dim r As Range
Dim rng As Range
Dim colMax As Variant
Dim rNextCellDown As Range

Set rng = Range("AG4:AK4")

'find first max value column in range - this only works if the range is on one row
colMax = Evaluate("=MATCH(MAX(" & rng.Address & ")," & rng.Address & ",0)")

If Not IsError(colMax) Then
'add 50 to the next cell down
Set rNextCellDown = rng.Cells(2, colMax)
rNextCellDown.Value = rNextCellDown.Value + 50
End If

End Sub
``````

See attached example.

Dave
doWork-r1.xls
Author Commented:
Hi Dave,

Here is my final code.  It does what I need it to do - however I have duplicated steps depending of the the r1.range value.  I wanted to create a seperate sub-routine to call that would complete the duplicated steps - but I could not get it to do that.  If you can take this exisiting code and slim it down, then that will help me greatly.  That is if you have the time.

Thanks,
Michael

Private Sub Worksheet_Activate()

ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Me.Application.ActiveWindow.Zoom = 85

range("AG9,AI9,AK9").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C[1])" 'Reset WS with no formats
range("AG9:AK9").Font.Bold = False
range("AG38:AK38").Select
With Selection
.Font.Bold = False
.Font.ColorIndex = 1
.Interior.ColorIndex = xlNone
End With

Dim r As range, res As Variant
Dim r1 As range, lmax As Double
Set r = range("AG4:AK4")

lmax = Application.Max(r)
res = Application.Match(lmax, r, 0)

If Not IsError(res) Then
Set r1 = r(res)
r1.Select

If r1 = range("AG4") Then

range("AG9").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C[1])+1"

r1.Offset(5).Select
With Selection
.Font.Bold = True
End With

r1.Offset(34).Select
With Selection
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 14
End With

ActiveSheet.Shapes("DINNER1").Left = range("AG8").Left
ActiveSheet.Shapes("DINNER1").IncrementLeft -5.25

ElseIf r1 = range("AI4") Then

range("AI9").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C[1])+1"

r1.Offset(5).Select
With Selection
.Font.Bold = True
End With

r1.Offset(34).Select
With Selection
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 14
End With

ActiveSheet.Shapes("DINNER1").Left = range("AI8").Left
ActiveSheet.Shapes("DINNER1").IncrementLeft -5.25

ElseIf r1 = range("AK4") Then

range("AK9").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C[1])+1"

r1.Offset(5).Select
With Selection
.Font.Bold = True
End With

r1.Offset(34).Select
With Selection
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 14
End With

ActiveSheet.Shapes("DINNER1").Left = range("AK8").Left
ActiveSheet.Shapes("DINNER1").IncrementLeft -5.25
End If

Else
End If

range("G12").Select

End Sub
Commented:
Here's a first pass rewrite:

``````Private Sub Worksheet_Activate()
Dim r As Range, res As Variant
Dim r1 As Range, lmax As Double

ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Me.Application.ActiveWindow.Zoom = 85

Range("AG9,AI9,AK9").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C[1])"    'Reset WS with no formats
Range("AG9:AK9").Font.Bold = False

With Range("AG38:AK38")
.Font.Bold = False
.Font.ColorIndex = 1
.Interior.ColorIndex = xlNone
End With

Set r = Range("AG4:AK4")

lmax = Application.Max(r)
res = Application.Match(lmax, r, 0)

If Not IsError(res) Then

Set r1 = r(res)

If Not Intersect(r1, Range("AG4")) Is Nothing Then

Range("AG9").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C[1])+1"

r1.Offset(5).Font.Bold = True
With r1.Offset(34)
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 14
End With

ActiveSheet.Shapes("DINNER1").Left = Range("AG8").Left
ActiveSheet.Shapes("DINNER1").IncrementLeft -5.25

ElseIf Not Intersect(r1, Range("AI4")) Is Nothing Then

Range("AI9").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C[1])+1"

r1.Offset(5).Font.Bold = True

With r1.Offset(34)
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 14
End With

ActiveSheet.Shapes("DINNER1").Left = Range("AI8").Left
ActiveSheet.Shapes("DINNER1").IncrementLeft -5.25

ElseIf Not Intersect(r1, Range("AK4")) Is Nothing Then

Range("AK9").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C[1])+1"

r1.Offset(5).Font.Bold = True

With r1.Offset(34)
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 14
End With

ActiveSheet.Shapes("DINNER1").Left = Range("AK8").Left
ActiveSheet.Shapes("DINNER1").IncrementLeft -5.25
End If

Else
'do nothing
End If

Range("G12").Select

End Sub
``````
Commented:
I did this pretty quickly, but believe this second pass is correct:

``````Private Sub Worksheet_Activate()
Dim r As Range, res As Variant
Dim r1 As Range, lmax As Double

ActiveWindow.ScrollColumn = 1
ActiveWindow.ScrollRow = 1
Application.ActiveWindow.Zoom = 85

Range("AG9,AI9,AK9").FormulaR1C1 = "=SUM(R[-4]C:R[-1]C[1])"    'Reset WS with no formats
Range("AG9:AK9").Font.Bold = False

With Range("AG38:AK38")
.Font.Bold = False
.Font.ColorIndex = 1
.Interior.ColorIndex = xlNone
End With

Set r = Range("AG4:AK4")

lmax = Application.Max(r)
res = Application.Match(lmax, r, 0)

If Not IsError(res) Then

Set r1 = r(res)

If Not Intersect(r1, Range("AG4")) Is Nothing Or Not Intersect(r1, Range("AI4")) Is Nothing Or Not Intersect(r1, Range("AK4")) Is Nothing Then
r1.Offset(5, 0).FormulaR1C1 = "=SUM(R[-4]C:R[-1]C[1])+1"

r1.Offset(5).Font.Bold = True
With r1.Offset(34)
.Font.Bold = True
.Font.ColorIndex = 2
.Interior.ColorIndex = 14
End With

ActiveSheet.Shapes("DINNER1").Left = r1.Offset(4, 0).Left
ActiveSheet.Shapes("DINNER1").IncrementLeft -5.25

End If

Else
'do nothing
End If

Range("G12").Select

End Sub
``````

Note, with few exceptions, selecting or activating anything on the sheet is not required and slows code down, and can trigger events based on sheet activation/selection as well.  I advise against it.  Using With adds value when doing more than one operation against a range, and it actually speeds up processing and is sometimes easier to read, but I'm not sure using With on one statement adds much value.

Cheers,

Dave

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Author Commented:
Thanks for doing this - I learn something everytime form you guys.

Thanks again,
Michael
###### It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.