mike637
asked on
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
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
Here's one way, if you have one to many rows to examine:
And, if you're just working one row, the Evaluate of the MATCH(MAX function should work and be pretty efficient at it:
See attached example.
Dave
doWork-r1.xls
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
ASKER
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.ActiveWindo w.Zoom = 85
range("AG9,AI9,AK9").Formu laR1C1 = "=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("DINNER 1").Left = range("AG8").Left
ActiveSheet.Shapes("DINNER 1").Increm entLeft -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("DINNER 1").Left = range("AI8").Left
ActiveSheet.Shapes("DINNER 1").Increm entLeft -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("DINNER 1").Left = range("AK8").Left
ActiveSheet.Shapes("DINNER 1").Increm entLeft -5.25
End If
Else
End If
range("G12").Select
End Sub
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.ActiveWindo
range("AG9,AI9,AK9").Formu
range("AG9:AK9").Font.Bold
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("DINNER
ActiveSheet.Shapes("DINNER
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("DINNER
ActiveSheet.Shapes("DINNER
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("DINNER
ActiveSheet.Shapes("DINNER
End If
Else
End If
range("G12").Select
End Sub
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks for doing this - I learn something everytime form you guys.
Thanks again,
Michael
Thanks again,
Michael
ASKER
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.