Solved

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

Posted on 2013-02-07
Medium Priority
1,012 Views
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
0
Question by:mike637
• 2
• 2
• 2

LVL 23

Expert Comment

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

Michael
0

LVL 23

Expert Comment

ID: 38866955
sorry attach failed, try again

Michael
0

Author Comment

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

LVL 32

Accepted Solution

Robberbaron (robr) earned 2000 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
``````
0

Author Closing Comment

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

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
``````
0

## Featured Post

Question has a verified solution.

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

Quickbooks hosting can do wonders to your enterprise but considering the points elaborated in the article which will help you to better analyze the outcomes. So scan your business, its needs and then move to the new world of limitless benefits.
MS Outlook undoubtedly is the most widely used email client.Its user-friendliness, cost effectiveness, and availability with Microsoft Office Suite make it the most popular email application.  Its compatibility with Microsoft applications like Exch…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…
###### Suggested Courses
Course of the Month13 days, 18 hours left to enroll