Speeding up Array

G

gti_jobert

Hi all,

I have the following code that loop through a sheet and fills a
Array;


Code
-------------------

i = 1
Do
ActiveSheet.Cells(i, 5).Select
If Left(ActiveCell.Value, 4) = "HDW-" Then
machine = Mid(ActiveCell.Value, 3, 1) & Right(ActiveCell.Value, 3)
j = i + 7
Do
If Len(ActiveSheet.Cells(j, 4).Value) = 9 Then

maxArray = maxArray + 1
ReDim Preserve Arry(1 To 5, 1 To maxArray)

Arry(1, maxArray) = machine
Arry(3, maxArray) = ActiveSheet.Cells(j, 4).Value 'Batch
Arry(2, maxArray) = ActiveSheet.Cells(j, 6).Value 'Part
Arry(4, maxArray) = (ActiveSheet.Cells(j, 7).Value / 1000) 'Qty
Arry(5, maxArray) = Left(ActiveSheet.Cells(j, 2).Value, 2) 'Week

EndWeek = Left(ActiveSheet.Cells(j, 2).Value, 2)

End If
j = j + 1
Loop Until ActiveSheet.Cells(j, 2).Value = ""
End If
i = i + 1
Loop Until Mid(ActiveCell.Value, 3, 1) & Right(ActiveCell.Value, 3) = "WH24"

-------------------


The problem I have is when I try to loop my values out of the array i
takes quite a long time.

How can I delete an Array value? I know I have to use Ubound o
something but I dont fully understand how it works!

Thanks for any input
 
R

RB Smissaert

It is slow for 2 reasons:
Selecting ranges, always try to avoid this.
Doing repeatedly ReDim Preserve. This will internally do a full array copy
everytime and that
slows things down.
Not sure it makes difference in speed here, but it is always better to
declare your variables.
To be forced to do this always put Option Explicit at the top of your
modules. Do in the VB editor:
Tools, Options, Editor, Require variable declaration.

Haven't tested, and it will need some editing, but something like this will
be much faster:


Sub test()

Dim i As Long
Dim j As Long
Dim c As Long
Dim LR As Long
Dim LR2 As Long
Dim arr
Dim arr2
Dim arr3

LR = Cells(65536, 5).End(xlUp).Row

arr = Range(Cells(5), Cells(LR, 5))

For i = 1 To UBound(arr)
If Mid(arr(i, 1), 3, 1) & Right(arr(i, 1), 3) = "WH24" Then
LR2 = i
Exit For
End If
Next

arr2 = Range(Cells(2), Cells(LR2, 7))
ReDim arr3(1 To 5, 1 To LR2)

For i = 1 To LR2

If Left(arr2(i, 4), 4) = "HDW-" Then

j = i + 7

Do
If Len(arr(j, 3)) = 9 Then
c = c + 1
arr3(1, c) = Mid(arr(i, 4), 3, 1) & Right(arr(i, 4), 3)
'machine
arr3(2, c) = arr2(j, 5).Value 'Part
arr3(3, c) = arr2(j, 3).Value 'Batch
arr3(4, c) = (arr2(j, 6).Value / 1000) 'Qty
arr3(5, c) = Left(arr2(j, 1), 2) 'Week
End If
j = j + 1
Loop Until Len(arr2(j, 1)) = 0

End If

Next

End Sub


Note that the final array is bigger (more columns) then needed, but that
shouldn't be a problem.


RBS
 
T

Tom Ogilvy

this may be a little faster. If one had greater knowledge of your data, it
is possible it could be improved even more:

Sub ABC()
Dim rng As Range, rng1 As Range
Dim sAddr As String, j As Long
Dim MaxArray As Long, machine As String
Dim EndWeek As String
Dim Arry()
ReDim Arry(1 To 5, 1 To 1)
MaxArray = 0

Set rng = Range(Cells(1, 5), _
Cells(Rows.Count, 5).End(xlUp))
Set rng1 = rng.Find(What:="HDW-*", _
After:=rng(rng.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not rng1 Is Nothing Then
sAddr = rng1.Address
Do
machine = Mid(rng1.Value, 3, 1) & Right(rng.Value, 3)

j = rng1.Row + 7
Do
If Len(Cells(j, 4).Value) = 9 Then

MaxArray = MaxArray + 1
ReDim Preserve Arry(1 To 5, 1 To MaxArray)

Arry(1, MaxArray) = machine
Arry(3, MaxArray) = Cells(j, 4).Value 'Batch
Arry(2, MaxArray) = Cells(j, 6).Value 'Part
Arry(4, MaxArray) = (Cells(j, 7).Value / 1000) 'Qty
Arry(5, MaxArray) = Left(Cells(j, 2).Value, 2) 'Week

EndWeek = Left(Cells(j, 2).Value, 2)

End If
j = j + 1
Loop Until Cells(j, 2).Value = ""
Set rng1 = rng.FindNext(rng1)
Loop While rng1.Address <> sAddr
End If
End Sub

the logic here is slightly different than yours. If there are records
beginning with HDW- that occur after you would normally stop (test of WH24),
then this will process those as well. I assume that isn't the case.

You can use the same redim preserve statement you are using, but you will
only be able to remove data from the end of the array (in this case, the
upper part of the second dimension

redim preserve arry(1 to 5, 1 to Ubound(arry,2) - 1)

will remove the last set of values.
 
G

gti_jobert

Hi all,

Thanks for the replies...have used some of the code posted to speed i
up - no problems with the Array speed now :)

Just one more question tho...

I need to find out the maximum value of Arry(5, 1 to maxArray) - I loo
Week numbers in here. I have been trying to use excels Max function:

EndWeek = Application.Max(val1, val2) - this works when i try it for
values but how would I adapt it to feed my array values into it?

thanks again guys for help
 
G

gti_jobert

Hi all,

Thanks for the replies...have used some of the code posted to speed i
up - no problems with the Array speed now :)

Just one more question tho...

I need to find out the maximum value of Arry(5, 1 to maxArray) - I loo
Week numbers in here. I have been trying to use excels Max function:

EndWeek = Application.Max(val1, val2) - this works when i try it for
values but how would I adapt it to feed my array values into it?

thanks again guys for help
 
G

gti_jobert

Hi all,

Thanks for the replies...have used some of the code posted to speed i
up - no problems with the Array speed now :)

Just one more question tho...

I need to find out the maximum value of Arry(5, 1 to maxArray) - I loo
Week numbers in here. I have been trying to use excels Max function:

EndWeek = Application.Max(val1, val2) - this works when i try it for
values but how would I adapt it to feed my array values into it?

thanks again guys for help
 
G

gti_jobert

Hi all,

Thanks for the replies...have used some of the code posted to speed i
up - no problems with the Array speed now :)

Just one more question tho...

I need to find out the maximum value of Arry(5, 1 to maxArray) - I loo
Week numbers in here. I have been trying to use excels Max function:

EndWeek = Application.Max(val1, val2) - this works when i try it for
values but how would I adapt it to feed my array values into it?

thanks again guys for help
 
G

gti_jobert

Hi all,

Thanks for the replies...have used some of the code posted to speed i
up - no problems with the Array speed now :)

Just one more question tho...

I need to find out the maximum value of Arry(5, 1 to maxArray) - I loo
Week numbers in here. I have been trying to use excels Max function:

EndWeek = Application.Max(val1, val2) - this works when i try it for
values but how would I adapt it to feed my array values into it?

thanks again guys for help
 
G

gti_jobert

Hi all,

Thanks for the replies...have used some of the code posted to speed i
up - no problems with the Array speed now :)

Just one more question tho...

I need to find out the maximum value of Arry(5, 1 to maxArray) - I loo
Week numbers in here. I have been trying to use excels Max function:

EndWeek = Application.Max(val1, val2) - this works when i try it for
values but how would I adapt it to feed my array values into it?

thanks again guys for help
 
B

bart.smissaert

Simply loop through your array, for example

dim i as Long
dim lMax as Long

for i = 1 to maxArray
if Arry(1, i) > lMax then
lMax = Arry(1, i)
end if
next

RBS
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads


Top