Solved

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

Posted on 2013-02-07
8
850 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
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 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

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

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

920 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

13 Experts available now in Live!

Get 1:1 Help Now