Do a calculation on only 1 row of a group of rows

BEBaldauf
BEBaldauf used Ask the Experts™
on
As part of a larger macro, I am selecting a group of rows based on a certain value.  I need to select only one to run a calculation on.

-Find rows that have identical CombinedSection numbers
-Find the row with the largest FullValue
-Copy that FullValue to the Percent cell only on that row

Here is what it should end up like:

Class       CombinedSection     Instructor       FullValue      Percent
12345     0450-0001                Smith, Joe       10.00           10.00
12346     0450-0001                Smith, Joe       9.00
12347     0450-0001                Smith, Joe       8.00
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2012
Top Expert 2012

Commented:
A VBA solution is certainly do-able.  

However, wouldn't you like to just use a formula, instead?

If your data starts in A2, and goes to row 100 (you can increase that to a larger number, if needed to support the # rows you have in the worksheet) you can put the Percent value in column E, e.g.:


[E2]=IF(MAX(($D$2:$D$100)*($B$2:$B$100=B2))=$D2,$D2,"")

And hit CTRL+SHIFT+ENTER to confirm the array formula.  You can edit the formula after you paste it in, by hitting F2, then hit CTRL+SHIFT+ENTER to confirm.

Then copy down.

See attached.

Cheers,

Dave
findMaxPercent-r1.xls

Author

Commented:
Hi Dave,

I'm handling all the calculations through a series of macros, because there are so many of them with lots of nested If..Then scenarios - this being one of them.  

Any way to turn this into VBA?

Thanks,
Bethyn
Most Valuable Expert 2012
Top Expert 2012

Commented:
Ok.

Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim r As Range

    Set wkb = ThisWorkbook
    Set wks = wkb.ActiveSheet
    
    Set rng = wks.Range("A2", wks.Range("A" & wks.Rows.Count).End(xlUp))
    
    Set rng = rng.Offset(, 4).Resize(, 1)
    rng.Cells(1, 1).FormulaArray = "=IF(MAX(($D$2:$D$100)*($B$2:$B$100=B2))=$D2,$D2,"""")"
    rng.FillDown
    
    rng.Value = rng.Value
    
End Sub

Open in new window


See attached.

Dave
findMaxPercent-r2.xls
Become a Microsoft Certified Solutions Expert

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

Author

Commented:
Could a For...Next loop be used so a formula wouldn't have to be written into the cell?
Most Valuable Expert 2012
Top Expert 2012

Commented:
It is a bit more sophisticated logic to figure this out without the formula.  Perhaps a for next loop to paste the formula one at a time, then clear it?  That should still be MUCH faster than doing the logic the formula is doing via VBA.

Your call.

Thoughts?

Dave
Most Valuable Expert 2012
Top Expert 2012

Commented:
Here's a solution without using the formula at all.  With the formulaic approach, using a loop, only one iteration would be required.

Option Explicit

Sub updatePercent()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim r As Range
Dim myDict As Object

    Set wkb = ThisWorkbook
    Set wks = wkb.ActiveSheet
    
    Set myDict = CreateObject("Scripting.Dictionary")
    
    Set rng = wks.Range("B2", wks.Range("B" & wks.Rows.Count).End(xlUp))
    
    For Each r In rng
        If myDict.exists(r.Value) Then
            If myDict(r.Value) < r.Offset(, 2).Value Then
                myDict(r.Value) = r.Offset(, 2).Value
            End If
        Else
            myDict.Add r.Value, r.Offset(, 2).Value
        End If
    Next r
    
    For Each r In rng
        If myDict(r.Value) = r.Offset(, 2).Value Then
            r.Offset(, 3).Value = r.Offset(, 2).Value
        End If
    Next r
    
    myDict.RemoveAll
    Set myDict = Nothing
End Sub

Open in new window


See attached.

Dave
fixMaxPercent-r3.xls

Author

Commented:
Thanks, i will give that a try.  May take me a little time to implement.  

What does the Offset do? (just so I grasp a little of what you did)
Most Valuable Expert 2012
Top Expert 2012
Commented:
Here's the solution with only one iteration, using the formula - probably the most efficient.

Option Explicit

Sub updatePercent()
Dim wkb As Workbook
Dim wks As Worksheet
Dim rng As Range
Dim r As Range

    Set wkb = ThisWorkbook
    Set wks = wkb.ActiveSheet
    
    Set rng = wks.Range("A2", wks.Range("A" & wks.Rows.Count).End(xlUp))
    
    Set rng = rng.Offset(, 4).Resize(, 1)
    
    For Each r In rng
        r.FormulaArray = "=IF(MAX(($D$2:$D$100)*($B$2:$B$100=B" & r.Row & "))=$D" & r.Row & ",$D" & r.Row & ","""")"
        r.Value = r.Value
    Next r
    
End Sub

Open in new window


See attached.

Dave
findMaxPercent-r4.xls
Most Valuable Expert 2012
Top Expert 2012

Commented:
Offset is moving so many rows or columns from a starting point.

r.Offset(,4) would be equivalent to for columns to the right of r, same rows.

Dave

Author

Commented:
screen capI'm having trouble even getting the MAX formula to work right in the cell.  Here's a screenshot.  I stripped out the IF part and get the same result.  I always get the value of whatever row the formula is in.
Most Valuable Expert 2012
Top Expert 2012

Commented:
You might try ensuring that your formula is array-entered.  Go to the formula, hit F2, then CRTL+SHIFT+ENTER.

Also, it looks like you eliminated a column, and shifted this dataset around from being something that starts in column A, so ensure you have your formula correct.

e.g., It should be

[AP2]=IF(MAX(($AN$2:$AN$100)*($AJ$2:$AJ$100=AJ2))=$AN2,$AN2,"")

CTRL+SHIFT+ENTER to confirm.

Why are you not using the macro, now?  PS - uploading a sample is better than having me type all this in to update/correct your formula, lol :P

See attached, formula based approach.

Dave
findMaxPercent-r11.xls

Author

Commented:
sorry, when I couldn't quite get the macro working, i thought i'd try just the formula.  And you are right, it's the array issue with the formula so now that works.  This will help me work on either the macro or the formula now, so i think i'm good to go!  appreciate your assistance!
Most Valuable Expert 2012
Top Expert 2012

Commented:
Do you want me to update the macro to work with those columns, or are you good to go?

Dave

Author

Commented:
think i'm good, thanks!!!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial