Solved

Excel VBA sort by absolute value then copy minimum and maximum values

Posted on 2013-02-07
8
838 Views
Last Modified: 2013-02-19
Hello Experts,

I have an Excel workbook that has a routine that was developed by one of the Experts here on Experts Exchange.   In each of the 20 ranges - it loops through and finds the 2 highest and 2 lowest values from sheet(KEYDATA) and copies those values to sheet1.

However, I need to make one change where I need assistance:
On sheet(KEYDATA).range("x3:x13) - I need to use the absolute value of the cells in the range then find the 2 lowest values and the 2 highest values to copy to sheet1.
I am attaching the workbook to help assist.

The routine is in module 1 called GetMinMax that sorts and identifies the cells to copy.

As you read the code - you will see that I will use the following criteria to place the identifed absolute values from range("x3:x13) into sheet1.

            wksh.Cells(trn, 2) = maxs1
            wksh.Cells(trn, 3) = max1
            wksh.Cells(trn, 5) = maxs2
            wksh.Cells(trn, 6) = max2
            wksh.Cells(trn, 9) = mins2
            wksh.Cells(trn, 10) = min2
            wksh.Cells(trn, 12) = mins1
            wksh.Cells(trn, 13) = min1

Any assistance to add additonal code to use absolute values for this range will be very helpful.

Thank you,
Michael
Monthy-Business-Review.xlsm
0
Comment
Question by:mike637
  • 2
  • 2
  • 2
8 Comments
 
LVL 23

Expert Comment

by:Michael74
ID: 38866952
Please find attached an updated workbook with the requested change

Michael
0
 
LVL 23

Expert Comment

by:Michael74
ID: 38866955
sorry attach failed, try again

Michael
Monthy-Business-Review.xlsm
0
 

Author Comment

by:mike637
ID: 38868043
Hi Michael74,

I tried your modified code and it identifed the incorrect abs values. All the other tested columns continue to work correctly.

These are the values I used to test:

x3 = -3520                                               this should have been max1
x4 =    204                                  
x5 =      23                                               this should have been min1
x6 =    330    Used this as min2
x7 =      65    Used this as min1             this should have been min2
x8 =  2037                                               this should have been max 2
x9 =   -312
x10= 1875
x11=  -138
x12=   228  Used this as max1
x13=   315  Used this as max2

In addition, the orginal value (non absolute value) needs to be transferred to sheet1.

Any suggestions on how to get it to identify the correct minimum and maximum and also to have the non-abs value copied to sheet1.

Michael
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 32

Accepted Solution

by:
Robberbaron (robr) earned 500 total points
ID: 38884255
there were a couple of errors.

this works for me but i have assumed that all cells in KeyData table hold numerics as that is how you initialise the max & min holders. is this correct ?

i changed the variable name from val to valX, just out of habit as val is a reserved function.
i used a string compare to check which column is to be based on ABS so that it is easier to change later if you add a column into KeyData.

Private Sub GetMaxMin()

    Dim sh As Worksheet, wksh As Worksheet, valX As Single
    Dim UseABS As Boolean
    
    Set sh = KEYDATA
    Set wksh = sh.Previous
    
    For Each ttl In DATA.range("A1:A" & DATA.range("A1").End(xlDown).Row)
        
        scn = WorksheetFunction.Match(ttl.Offset(, 1), KEYDATA.range("1:1"), 0)
        trn = WorksheetFunction.Match(ttl, wksh.range("A:A"), 0) + 3
        
        max1 = -9E+99: min1 = 9E+99
        max2 = -9E+99: min2 = 9E+99
        
        Select Case ttl
            Case "Reported Gross Profit $  -vs-  Actual"
                UseABS = True
            Case Else
                UseABS = False
        End Select
        
        For Each cel In range(KEYDATA.Cells(3, scn), KEYDATA.Cells(13, scn))
            
            If cel <> "" Then
                If UseABS Then
                   If IsNumeric(cel.Value) Then valX = Abs(cel.Value)
                Else
                   valX = cel.Value
                End If
                

                If valX > max1 Then
                    max2 = max1: max1 = valX
                    maxs2 = maxs1
                    maxs1 = cel.Offset(, 1 - cel.Column)
                ElseIf valX > max2 Then
                    max2 = valX
                    maxs2 = cel.Offset(, 1 - cel.Column)
                End If
                
                If valX < min1 Then
                    min2 = min1: min1 = valX
                    mins2 = mins1
                    mins1 = cel.Offset(, 1 - cel.Column)
                ElseIf valX < min2 Then
                    min2 = valX
                    mins2 = cel.Offset(, 1 - cel.Column)
              
                End If
                
            End If
            
        Next cel
       
    Application.EnableEvents = False
        
        If ttl.Offset(, 2) = "L" Then
        
            wksh.Cells(trn, 2) = mins1
            wksh.Cells(trn, 3) = min1
            wksh.Cells(trn, 5) = mins2
            wksh.Cells(trn, 6) = min2
            wksh.Cells(trn, 9) = maxs2
            wksh.Cells(trn, 10) = max2
            wksh.Cells(trn, 12) = maxs1
            wksh.Cells(trn, 13) = max1
        
        Else
        
            wksh.Cells(trn, 2) = maxs1
            wksh.Cells(trn, 3) = max1
            wksh.Cells(trn, 5) = maxs2
            wksh.Cells(trn, 6) = max2
            wksh.Cells(trn, 9) = mins2
            wksh.Cells(trn, 10) = min2
            wksh.Cells(trn, 12) = mins1
            wksh.Cells(trn, 13) = min1
            
         End If
        
    Next ttl
      
    Application.EnableEvents = True
   
    Beep
    MsgBox "DATA UPDATED", vbOKOnly + vbInformation, "TRANSFER DATA"
    
    wksh.Activate
    
   
   Set sh = Nothing
   Set wksh = Nothing
        
End Sub

Open in new window

0
 

Author Closing Comment

by:mike637
ID: 38898794
Thank you robberbaron!!

I am going to start with your code which definatley will help.  It sorted perfectly - but I do need to copy the non-ABS value to the previous sheet.  So I might just have a hidden column that it sorts and copies that hidden column.

Thank you again,
Michael
0
 
LVL 32

Expert Comment

by:Robberbaron (robr)
ID: 38904503
i think you could do that in the routine.

create a min1compare, min2compare, etc based upon ABS or not.

use those in the compare if's

not tested at all....
               If UseABS Then
                   If IsNumeric(cel.Value) Then valX = Abs(cel.Value)
                   max1comp = Abs(max1): max2comp = Abs(max2)
                   min1comp = Abs(min1): min2comp = Abs(min1)
                Else
                   valX = cel.Value
                   max1comp = max1: max2comp = max2
                   min1comp = min1: min2comp = min1
                End If
                

                If valX > max1comp Then
                    max2 = max1: max1 = valX
                    maxs2 = maxs1
                    maxs1 = cel.Offset(, 1 - cel.Column)
                ElseIf valX > max2comp Then
                    max2 = valX
                    maxs2 = cel.Offset(, 1 - cel.Column)
                End If
                
                If valX < min1comp Then
                    min2 = min1: min1 = valX
                    mins2 = mins1
                    mins1 = cel.Offset(, 1 - cel.Column)
                ElseIf valX < min2comp Then
                    min2 = valX
                    mins2 = cel.Offset(, 1 - cel.Column)
              
                End If

Open in new window

0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Suggested Solutions

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

758 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

21 Experts available now in Live!

Get 1:1 Help Now