Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.
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
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
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
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
If you are experiencing a similar issue, please ask a related question
Title | # Comments | Views | Activity |
---|---|---|---|
Finding a closest match in Excel | 7 | 36 | |
VBA to apply same filter values to multiple tables in Excel | 6 | 26 | |
E2 + M2 = N2 == 10:02 AM | 3 | 19 | |
why excel offset of negative and positive shows incorrect Delta, please see attached | 2 | 17 |
Join the community of 500,000 technology professionals and ask your questions.
Connect with top rated Experts
10 Experts available now in Live!