extracting a single row from a multi row/column range

[dgs2001]

Hello All

I am stumped :dunno
I use the following code in a custom function, I pass into this function a dynamic range which is always 75 columns wide but varies in number of rows up to a maximum of 40, the number of rows in this range is passed into my function as value N.

The function should look for a value (passed in as "highest") in a specific column (passed in as "col") within the entire range then return just the row containing that highest number.


Function getPotential(v2 As Variant, N As Integer, highest As Double, col As Integer) As Range
Dim v As Variant, p As Variant
Dim i As Integer, j As Integer
Set v = v2
Set p = Nothing
For i = 3 To N

If v(i, col) = highest Then

''' I expect this next line to set range p to a single row from range v
Set p = Application.Index(v, i, 0)
''' However it doesnt, it sets p to all rows of v starting at i

End If
Next i
Set getPotential = p
End Function



The problem I'm having is with this line

Set p = Application.Index(v, i, 0)

The resulting output is not a single row by 75 column range but all rows from the original range starting at the row i


Please help as I'm starting to pull out clumps of hair !!

Thanks in advance Dgs2001

[patel]

attach a sample file with data and desired result

[dgs2001]

Hi here is a sample of the data


Public Sub testRangeExtract()
Dim r As Range, col As Integer, n As Integer
Dim potential As Range
Dim pot1 As Range
Dim pot2 As Range
Set r = ThisWorkbook.Sheets(1).Range("a2:bw19")
col = 20
n = 16
Set pot1 = getPotential(r, n, col) ''' pot 1 should be returned as a single row from our range r
' This comes up correctly as 3 - The contents of A6
Debug.Print pot1(1, 1)
Set r = ThisWorkbook.Sheets(1).Range("a23:bw33")
col = 24
n = 11
Set pot2 = getPotential(r, n, col) ''' pot2 should be returned as a single row from our range r2
' This comes up correctly as 10 - The contents of A25
Debug.Print pot2(1, 1)
' I Believe this is the problem line !!
Set potential = Application.Union(pot1, pot2) ''' What i need is to join pot1 and pot2 to give me a two row range, in this exampl rows 6 and 25
Debug.Print potential(1, 1) ' in this example this should be equal to 3 the first cell in row 6
Debug.Print potential(2, 1) ' in this example this should be equal to 10 the first cell in row 25
End Sub

Function getPotential(r, n, col) As Range
Dim rR As Range, rCell As Range
Dim high As Double
Dim i As Integer
Set rR = r.Columns(col)
high = Application.WorksheetFunction.Max(rR)
For i = 3 To n
If r(i, col) = high Then
Set getPotential = Application.Index(r, i, 0)
Exit Function
End If
Next
Set getPotential = Nothing
End Function


This is the code in the attached workbook which hopefully explains what Im trying to achieve.


Thanks Duncan

[patel]

I think you can not use matrix indexing with not contiguous ranges, you can solve with
Public Sub testRangeExtract()
Dim r As Range, col As Integer, n As Integer
Dim potential As Range
Dim pot1 As Range
Dim pot2 As Range
Set r = ThisWorkbook.Sheets(1).Range("a2:bw19")
col = 20
n = 16
Set pot1 = getPotential(r, n, col) ''' pot 1 should be returned as a single row from our range r
Debug.Print pot1(1, 1)
Set r = ThisWorkbook.Sheets(1).Range("a23:bw33")
col = 24
n = 11
Set pot2 = getPotential(r, n, col)
Debug.Print pot2(1, 1)
Set potential = Union(pot1, pot2)
potential.Copy Sheets(2).Range("a1")
Set Rng = Sheets(2).Range("A1").CurrentRegion
Debug.Print Rng(1, 1)
Debug.Print Rng(2, 1)
End Sub

[dgs2001]

Thanks

I think I need to become better acquainted with areas.!

[snb]

I don't think that is the problem.
Application.union doesn't combine two areas into 1.
You can achieve what you want using some less code:


Sub M_snb()
Dim sp(1, 74)

For j = 0 To UBound(sp)
sn = getPotential(ThisWorkbook.Sheets(1).Range(Choose(j + 1, "a2:bw19", "a23:bw33")), 20)
For jj = 0 To UBound(sp, 2)
sp(j, jj) = sn(1, jj + 1)
Next
Next
MsgBox sp(0, 0) & vbTab & sp(1, 0)
End Sub

Function getPotential(r As Range, col)
getPotential = ThisWorkbook.Sheets(1).UsedRange.Rows(r.Columns(col).Find(Application.Max(r .Columns(col)), , xlFormulas, 1).Row)
End Function