Solved

Find column with max value

Posted on 2012-03-31
6
307 Views
Last Modified: 2012-03-31
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
0
Comment
Question by:mike637
  • 3
  • 3
6 Comments
 

Author Comment

by:mike637
ID: 37791214
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.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37791290
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

Open in new window


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

Open in new window


See attached example.

Dave
doWork-r1.xls
0
 

Author Comment

by:mike637
ID: 37791493
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
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 41

Expert Comment

by:dlmille
ID: 37791526
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

Open in new window

0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 37791537
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

Open in new window


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
0
 

Author Closing Comment

by:mike637
ID: 37791571
Thanks for doing this - I learn something everytime form you guys.

Thanks again,
Michael
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Excel Formula 4 28
Search for a value in Column? 5 21
Excel 2016 - Black cell borders 11 27
Excel - find text within text? 1 24
INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

895 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now