Trouble With VBA Median Function XL2010

[NeedyHelpExcelMan]

Hello All:

I am writing code in XL2010 and I have a question RE Median Functions in VBA. I have a column of data in column B and F. I want to produce a value in column G (calculated using data from Column F) given a criteria in column B. Below is an example of the data.

I'd like a function that would be able to recognize for all "100"s in column B, pull the correspond data in column F and find the median of it. Then take the value in column F and subtract the median of the corresponding median. For example cell G2 would be equal to: =F2-MEDIAN(F2:F5); G3 would be: =F3-MEDIAN(F2:F5) and so on and so forth. If this needs further explanation, please comment and let me know. Thanks in advance

B	F	G
100	10000
100	10000
100	12000
100	15000
101	50000

<TBODY>
</TBODY>

 

[NeedyHelpExcelMan]

	B	C	D	E	F	G
1
2	Code	ID	*Hidden	*Hidden	Value	Differential
3	10000	1			48,182.44
4	10000	2			48,000
5	10000	3			43,794.21
6	10000	4			37,428.16
7	10002	5			64,068.29
8	10003	6			49,182.11
9	10003	7			41,490.14
10	10005	8			29,548.80

<TBODY>
</TBODY>

The above table is taken directly from what I am trying to accomplish. The vba you've given me works when column B = "10000" but not when that "10000" value changes. The goal is to have me input a value and have G return a value given the criteria I set. Maybe some sort of hybrid of your code and this:

Dim SearchCode As Variant
    Dim SearchValue As String
Dim ValueRange As Range
    Dim Differential As String
    SearchCode = "10000"
    SearchValue= "48,182.44"
    ValueRange= ' All values where SearchCode = 10000     
Dim N as double, Dim i as double

N = Application.WorksheetFunction.CountA(Range(Range("B3"), Range("B3").End(xlDown)))

For i = 1 To N
        
        If Range("B3").Offset(i, 0).Value = SearchCode Then
            If Range("F3").Offset(i, 0).Value = SearchValue Then
                ' Produce the median of ValueRange and have Differential _
be equal to SearchValue - ValueRange
                Range("G3").Offset(i, 0).Value = Differential
            End If
        End If
    Next

Obviously very flawed but a start ^

Thanks again for your help

 

[Andrew Poulsom]

The code I posted uses the value in column B on each row. The value isn't hard coded.

 

[NeedyHelpExcelMan]

Right but the range is fixed, and column F returns #NUM! as soon as the value in column B changes.

 

[Andrew Poulsom]

What range is fixed in my code?

 

[NeedyHelpExcelMan]

It returns #NUM! for all the cells in column F

 

[Andrew Poulsom]

Maybe the entries in column F are text rather than numbers. You can use the ISNUMBER function to check, and Data|Text To Columns to convert.

 

[NeedyHelpExcelMan]

ISNUMBER returns "False" but using Text To Columns still leaves #NUM! as the values in column F.

Here is a copy of my complete code & see table in above comments (at the very end is where I am running your code) - which copies #NUM! down the entire F column (also, copies the cell formatting from F2 throughout the entire column):

Sub ChangeVals()
 Cells.Select
    Selection.EntireColumn.Hidden = False
    
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    PrevCalc = .Calculation
    .Calculation = xlCalculationManual
End With
Sheets("Data Sheet").Select
    Range("E4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Race-Ethnicity (3)").Select
    Range("B3").Select
    ActiveSheet.Paste
    Range("C3").Select
    
    Sheets("Data Sheet").Select
    Range("K4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Race-Ethnicity (3)").Select
    Range("D3").Select
    ActiveSheet.Paste
    Range("F3").Select
    
    Sheets("Data Sheet").Select
    Range("B4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Race-Ethnicity (3)").Select
    Range("C3").Select
    ActiveSheet.Paste
    
    Range("H3").Select
    Sheets("Data Sheet").Select
    Range("S4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Race-Ethnicity (3)").Select
    ActiveSheet.Paste
    
 
    Range("I3").Select
    Sheets("Data Sheet").Select
    Range("J4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Race-Ethnicity (3)").Select
    ActiveSheet.Paste
    Columns("H:H").ColumnWidth = 20.43
    Columns("B:B").ColumnWidth = 15.57
    Range("J3").Select
    Sheets("Data Sheet").Select
   
    Range("H4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Race-Ethnicity (3)").Select
    ActiveSheet.Paste
    Columns("I:I").ColumnWidth = 4.29
    Range("K3").Select
    Sheets("Data Sheet").Select
    
    Range("I4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Race-Ethnicity (3)").Select
    ActiveSheet.Paste
    
    Range("G3").End(xlDown).Select
    Selection.ClearContents
    

     With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = PrevCalc
End With
 Range("D:D,E:E").Select
    Selection.EntireColumn.Hidden = True
    
    Columns("H:H").ColumnWidth = 30.86
    Columns("I:I").ColumnWidth = 11
    Columns("J:J").ColumnWidth = 8
    Columns("K:K").ColumnWidth = 10
    Columns("I:I").ColumnWidth = 20.5
    
     ActiveWorkbook.Worksheets("Ethnicity (3)").AutoFilter.Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Ethnicity (3)").AutoFilter.Sort.SortFields. _
        Add Key:=Range("B:B"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Ethnicity (3)").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Dim LastRow As Long
    With ActiveSheet
        LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
        With .Range("G3")
            .FormulaArray = "=RC[-1]-MEDIAN(IF(R2C[-5]:R6C[-5]=RC[-5],R2C[-1]:R6C[-1]))"
            .Copy Range("G3:G" & LastRow)
        End With
        With .Range("G3:G" & LastRow)
            .Value = .Value
        End With
    End With
    Range("A2").Select

 

[Andrew Poulsom]

To help further I think I would need to see your workbook. Do you want to put it on a share like Box.com and post the URL?

 

[Christopher lee]

Hi NeedyHelpExcelMan,
i nw doing an assignment almost similar with u which is i would like to get a median of 1 of the column on my excel sheet...but i donknow hw to write the macro code to do it.....can u hlp me?
A f
1
2
3
4
5

A is the data column and i want to get the median of A and put in the column f...... can hlp??