|
-
Jul 14th, 2010, 04:47 PM
#1
Thread Starter
New Member
Array Problem
Hi,
I have the below code which when I execute I find the min and max values within a certain column. this column is in a multidimensional array. What i am trying to do is call the function to find min/max and then copy the entire row where the max and min values exist.
the data is
1:45:09 PM 2651 P 2250 1 0.479621887
2:05:09 PM 2655 P 2250 1 0.483436584
2:25:09 PM 2655 P 2250 1 0.483436584
2:45:09 PM 2666 P 2250 1 0.493812561
3:05:09 PM 2661 P 2250 1 0.489082336
3:25:09 PM 2667 P 2250 1 0.494728088
3:45:09 PM 2664 P 2250 1 0.491905212
4:05:09 PM 2659 P 2250 1 0.487174988
4:25:09 PM 2666 P 2250 1 0.493812561
4:45:09 PM 2659 P 2250 1 0.487174988
5:05:09 PM 2652 P 2250 1 0.480613708
the code is
-----------------------
Option Base 1
Public Function FindMax(arr() As Variant, col As Long) As Variant
Dim myMax As Variant
Dim i As Integer, j As Integer
Dim x(1, 13) As Variant
For i = LBound(arr(), 1) To UBound(arr(), 1)
If arr(i, col) > myMax Then
myMax = arr(i, col)
FindMax = myMax
End If
Next i
End Function
Public Function FindMin(arr() As Variant, col As Long) As Variant
Dim myMin As Variant
Dim i As Integer
myMin = 1
For i = LBound(arr(), 1) To UBound(arr(), 1)
If arr(i, col) < myMin Then
myMin = arr(i, col)
FindMin = myMin
End If
Next i
End Function
Sub edit()
Dim i As Integer, k As Double, j As Double, l As Double, m As Double, a As Double, b As Double, c As Double
Dim iRow As Integer, jRow As Integer
Dim arr() As Variant
k = 0
iRow = 1
Do Until IsEmpty(Cells(iRow, 7))
k = k + 1
iRow = iRow + 1
Loop
ReDim arr(k, 13)
jRow = 1
For l = 1 To k
arr(l, 1) = Cells(jRow, 1).Value
arr(l, 2) = Cells(jRow, 2).Value
arr(l, 3) = Cells(jRow, 3).Value
arr(l, 4) = Cells(jRow, 4).Value
arr(l, 5) = Cells(jRow, 5).Value
arr(l, 6) = Cells(jRow, 6).Value
arr(l, 7) = Cells(jRow, 7).Value
arr(l, 8) = Cells(jRow, 8).Value
arr(l, 9) = Cells(jRow, 9).Value
arr(l, 10) = Cells(jRow, 10).Value
arr(l, 11) = Cells(jRow, 11).Value
arr(l, 12) = Cells(jRow, 12).Value
arr(l, 13) = Cells(jRow, 13).Value
jRow = jRow + 1
Next l
Call FindMax(arr(), 7)
Call FindMin(arr(), 7)
End Sub
----------------
the bold rows, 2 of them, are the ones that I want to copy into a new sheet into excel
im not sure to do this in the function and return the whole row or can i do it from the array itself.. and this point i am trying to use the find address method but have no joy.
can anyone help?
also, is there any books, online tutorials that i can read through?
Sanka
-
Jul 14th, 2010, 04:54 PM
#2
Addicted Member
Re: Array Problem
a small tip, you dont need MyMax and MyMin. Just use the function space.
the rest looks pretty good though
Good luck with excel, I'm no help at the moment
-
Jul 15th, 2010, 01:09 AM
#3
Thread Starter
New Member
-
Jul 15th, 2010, 02:52 AM
#4
Thread Starter
New Member
-
Jul 15th, 2010, 04:49 AM
#5
Addicted Member
Re: Array Problem
Hi,
You are writing the code in Excel or in VB6..?
-
Jul 15th, 2010, 06:22 AM
#6
Thread Starter
New Member
Re: Array Problem
Hi Veena..
In VB6... I have figured that i dont need to return the max value, only the index of the max value..
Just a different way of thinking but i figured it out...
-
Jul 15th, 2010, 07:29 AM
#7
Re: Array Problem
this looks like it is vba code, written in the excel vb ide, if not all references to cells should be fully qualified with a sheet object, from an excel object
iRow = 1
Do Until IsEmpty(Cells(iRow, 7))
k = k + 1
iRow = iRow + 1
Loop
vb Code:
lastrow = cells(65535, 1).end(xlup).row myarr = range(cells(1, 1),cells(lastrow, 13))
you can also use application.worksheetfunction.max(myrange) to find max value in a range
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|