PDA

View Full Version : [SOLVED] Improve Multiple loop code



DaveGib
01-13-2016, 02:47 AM
Hi,
I would please like some help to improve the code of multiple loops.

I have a datasheet that has approx. 67 columns and between 1200 to 1500 rows.

I also have a report sheet that has only 20 columns.

The columns being searched are not regularly spaced, some might be consecutive, others several columns apart, but on the report sheet they are all consecutive.

I have created a simple loop that loops down the columns required, to extract the information required, from the datasheet, but with my limited knowledge I am switching between the two sheets on each hit and it is extremely slow.

I have a useform that gets two dates from the user - a 'from' date(f in the code below) and a 'to' date (t in the code below), and my logic is to loop down each of the 20 specific columns of the 67, and if the date falls between the two dates on the userform then to extract the information from the first column and transfer it to a 'Report' sheet and add it to the next row of the column, then switch back to the data sheet and carry on the loop of the datasheet!!! - very laborious

below is the code that works - but slowly!!

Any help would be greatly appreciated!!! - thanks in advance............



Dim i As Integer
Dim LC As Long '*** Loop Counter on report sheet
Dim LR As Integer '*** Last Row
Dim k As Variant '*** House Number

Sheets("Data").Select

LR = Range("A2000").End(xlUp).Row

'***** THIS BLOCK BELOW IS REPEATED 20 TIMES, JUST CHANGING THE COLUMN NUMBERS!!

LC = 13 ' ** First row in report

For i = 5 To LR

Sheets("Data").Select

'*** CHECK IF DATE IN CELL GREATER THAN BUT LESS THAN THE FROM AND TO DATES IN USERFORM
'*** THE 'f' AND 't' VALUES ARE DATES DERIVED FROM THE USERFORM.

If Cells(i, 6).Value > f And Cells(i, 6).Value < t Then
k = Cells(i, 1).Value '*** IF IT IS GET THE NUMBER FROM COLUMN A
Sheets("Reports").Select
Cells(LC, 4).Value = k '*** PUT VALUE IN NEXT LINE
LC = LC + 1
End If
Next i

SamT
01-13-2016, 07:12 AM
Sub Sample()
Dim i As Long 'Never, ever use an Integer for row and column numbers.
Dim LC As Long '*** Loop Counter on report sheet
Dim LR As Long '*** Last Row

Dim myColumns As Variant
Dim l As Long
Dim c As Long
myColumns = Array(6, c2, c3, c4, , , , c20) 'Edit to reflect your columns

LR = Sheets("Data").Range("A2000").End(xlUp).Row
LC = 13 ' ** First row in report

For l = LBound(myColumns) To UBound(myColumns)
c = myColumns(l)

For i = 5 To LR

' CHECK IF DATE IN CELL GREATER THAN BUT LESS THAN THE FROM AND TO DATES IN USERFORM
' THE 'f' AND 't' VALUES ARE DATES DERIVED FROM THE USERFORM.

If Sheets("Data").Cells(i, c) > f And Sheets("Data").Cells(i, c) < t Then
'PUT VALUE IN NEXT LINE
Sheets("Reports").Cells(LC, 4) = Sheets("Data").Cells(i, c)
LC = LC + 1
End If
Next i
Next l
End Sub

Paul_Hossler
01-13-2016, 07:45 AM
1. I'd bracket the For l loop with Application.ScreenUpdating = False and Application.ScreenUpdating = True

2. If there's a change that there's varying number of used cells in each column, I'd reset LR for each column to stop when I run out of data in that column

3. You could save a tiny bit by avoiding the AND if it fails on the first test


But what part 'runs slow'?




Sub Sample()
Dim i As Long 'Never, ever use an Integer for row and column numbers.
Dim LC As Long '*** Loop Counter on report sheet
Dim LR As Long '*** Last Row

Dim myColumns As Variant
Dim l As Long
Dim c As Long
myColumns = Array(6, c2, c3, c4, , , , c20) 'Edit to reflect your columns


Application.ScreenUpdating = False

LC = 13 ' ** First row in report

For l = LBound(myColumns) To UBound(myColumns)
c = myColumns(l)

LR = Sheets("Data").Cells(Sheets("Data").Rows.Count, c).End(xlUp).Row


For i = 5 To LR

' CHECK IF DATE IN CELL GREATER THAN BUT LESS THAN THE FROM AND TO DATES IN USERFORM
' THE 'f' AND 't' VALUES ARE DATES DERIVED FROM THE USERFORM.

If Sheets("Data").Cells(i, c) <= f Then GoTo NextI
If Sheets("Data").Cells(i, c) >= t Then GoTo NextI

'PUT VALUE IN NEXT LINE
Sheets("Reports").Cells(LC, 4) = Sheets("Data").Cells(i, c)
LC = LC + 1

End If
NextI:
Next I
Next l

Application.ScreenUpdating = True
End Sub

DaveGib
01-13-2016, 08:36 AM
Hi SamT,
Thanks So much for the code!! I have just tried it, and I can see it will do the job, but needs a couple of 'tweaks'

The code you supplied gets all the right 'hits' in the respective columns and transfers these 'hits' onto the report sheet, but it does so as a single column, and is recording the dates.

I apologise if I didn't make myself clear, and I apologise if I am not clear now, but..

When it finds a date in say column 7 in the data sheet, I need the number that is in the first column of the same row(column A).
This number is what must be taken to the report sheet and appended to say column 4 on the report sheet.
Once column 7 on data sheet has been completed, to go to next column say 15 and repeat, but the results from column 15 must be put in column 5 on the report sheet.

I hope I am making sense!!!

BTW your code is super fast!!

I edited your code to reflect my columns as:


myColumns = Array(6, 7, 15, 17, 22, 23, 25, 28, 29, 32, 35, 36, 38, 48, 49, 52, 54, 55, 57, 65, 67)

SamT
01-13-2016, 08:41 AM
@ Paul
If you're going for that Kind of speed, I would not use three references to the sheet

With Sheets("Data")

If .Cells(i, c) <= f Then GoTo NextI
If .Cells(i, c) >= t Then GoTo NextI

'PUT VALUE IN NEXT LINE
Sheets("Reports").Cells(LC, 4) = .Cells(i, c)
End With

If speed was Critical, Place each Column in an array, loop thru it and if Array(i) - f <= T then Array[1 to 20*LastRow](j) = Array(i).
CountA on Array[20*LastRow] and Redim Preserve it and put the whole thing into Reports in one fell swoop.

Note that I don't know if you can CountA on an array but you can

For i = Lbound(Arr) to UBound(Arr)
If Arr(i) = "" Then Exit For
Next
Redim Preserve Arr(i)
Reports.Range("D" & LC).Resize(i + 1) = Arr '+ 1 if Base 0

DaveGib
01-13-2016, 09:00 AM
Hi Paul,
Thanks very much for your input as well!!
After responding to SamT I edited his code a little - and did the same change to your code, and that is, - I changed:


Sheets("Reports").Cells(LC, 4) = Sheets("Data").Cells(i, c)
'TO
Sheets("Reports").Cells(LC, 4) = Sheets("Data").Cells(i, 1)

which gave the numbers in Column A (1) that I required, but I am still getting a long list.

If possible I would like the results of each individual column in the array be listed separately, in consecutive columns in the report sheet.

Thanks once again......

SamT
01-13-2016, 09:48 AM
If possible I would like the results of each individual column in the array be listed separately, in consecutive columns in the report sheet.


Dim col As Long
'
'
'
col = 4
For l = LBound(myColumns) To UBound(myColumns)

c = myColumns(l)
LC = 13
'
'
'
Sheets("Reports").Cells(LC, col) = Sheets("Data").Cells(i, 1)
''
'
'
LC = LC + 1
Next i

col = col + 1
Next l

DaveGib
01-13-2016, 11:31 AM
SamT,
I thank u sincerely for your inputs!!!

The code is working EXACTLY as needed, and instantly!!!

For the benefit of those who might have a similar request, here is the final code I used.

I would like to thank both SamT and Paul for your time and efforts - much appreciated!!

THANK YOU.....



Dim i as Long
Dim LC As Long '*** Loop Counter on report sheet
Dim LR As Long '*** Last Row

Dim myColumns As Variant
Dim l As Long
Dim c As Long
Dim col As Long

'*** SPECIFY WHICH COUMNS TO CHECK

myColumns = Array(6, 7, 15, 17, 22, 23, 25, 28, 29, 32, 35, 36, 38, 48, 49, 52, 54, 55, 57, 65, 67)

LR = Sheets("Data").Range("A2000").End(xlUp).Row

col = 4 ' ** First Column in Report Sheet

For l = LBound(myColumns) To UBound(myColumns)
c = myColumns(l)
LC = 13 ' ** First row in Report Sheet

For i = 5 To LR ' ** Data starts in 5th row of data sheet

'** Check if date falls between dates obtained from UserForm

If Sheets("Data").Cells(i, c) > f And Sheets("Data").Cells(i, c) < t Then

Sheets("Reports").Cells(LC, col) = Sheets("Data").Cells(i, 1)
LC = LC + 1
End If
Next i
col = col + 1
Next l

snb
01-13-2016, 02:48 PM
To reduce the interaction with the worksheet, use:


Sub M_snb()
sn = Sheets("Data").Cells(1).CurrentRegion
ReDim sp(1 To UBound(sn), 1 To 21)

For Each it In Array(6, 7, 15, 17, 22, 23, 25, 28, 29, 32, 35, 36, 38, 48, 49, 52, 54, 55, 57, 65, 67)
jj = jj + 1
jjj = 1

For j = 5 To UBound(sn)
If sn(j, it) > f And sn(j, it) < t Then
sp(jjj, jj) = sn(j, 1)
jjj = jjj + 1
End If
Next
Next

Sheets("Reports").Cells(13, 4).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub

SamT
01-13-2016, 05:38 PM
Dave, snb's code will be extremely fast. Like, "If you blink, you'll miss it," fast.

DaveGib
01-13-2016, 11:02 PM
Hi snb,
Fairies came in the night, whilst I was sleeping, and presented me with another, what looks like - and I believe SamT's comment!! - a lightning fast solution!!!!.

The code looks super slick, and I couldn't wait to try it when I saw it, but came across a couple of errors, and I am afraid my understanding of Arrays is a bit limited to say the least!

I first got a 'Variable not defined' error, stalling on sn = sheets, so I added 'Dim sn as Range' ( presuming that is right?)

When I ran it again it stopped with a 'Compile Error' - Expected array, and it highlights the word 'Ubound' in the ReDim statement.

As mentioned I am very green when it comes to arrays, and I am afraid I don't know how to fix this, - can you please help?


Many thanks for your time...........

snb
01-14-2016, 12:25 AM
Just remove or comment out 'option explicit'.

DaveGib
01-14-2016, 01:38 AM
Hi snb,
Thanks very much for the reply.
That does the trick as far as the errors go, but when I run the macro I don't get any results.
I tried stepping through, so that I can see and learn, and found that when it gets to the loop :



For Each it In Array(6, 7, 15, 17, 22, 23, 25, 28, 29, 32, 35, 36, 38, 48, 49, 52, 54, 55, 57, 65, 67)
jj = jj + 1
jjj = 1

For j = 5 To UBound(sn)
If sn(j, it) > f And sn(j, it) < t Then
Sp(jjj, jj) = sn(j, 1)
jjj = jjj + 1
End If
Next
Next


it jumps from ...... For j = 5..
to the outer loop Next.

the value of Ubound(sn) when I hover is 1

it does not go to the If Then statement once.

snb
01-14-2016, 02:25 AM
Take care that in sheets("data") none of row 1 to row 5 is empty.

Since you didn't provide a workbook we can only guess what it looks like.

A real 'data' sheet should start in A1 and contain no empty rows, nor empty columns.

DaveGib
01-14-2016, 04:08 AM
Hi snb,
thanks for that............ there were some blanks as I have some headings at the top. I did a layman's 'workaround' by putting a number in the blank cells above row 5 in column A, then hid the numbers by colouring them white.
Everything now works perfectly!!!

A HUGE thank you for some really neat code!!!! :hi:

P.S. - I just discovered your link "more suggestions" lead to your website, which is really cool!

Paul_Hossler
01-14-2016, 07:03 AM
Just remove or comment out 'option explicit'.


Difference of opinion here, but I'd leave it in, but Dim sn correctly (and Dim the other variables as well of course.) Without the OE and Dim- everything is a Variant

Variants take longer and use more memory, and don't allow proper Type checking (i.e. only Longs into a Long) to avoid errors. I prefer (again personal opinion) to use Variants sparingly and only when absolutely needed

Most likely it should be



Dim sn as Variant


Next week's topic: Using meaningful names for variables :devil2:

snb
01-14-2016, 07:33 AM
You know better than the inventor of E=mc2 ?

DaveGib
01-14-2016, 07:37 AM
Thanks Everyone for your inputs - I have learnt a lot from your various suggestions and comments, all of which have been noted and absorbed! - thanks!

SamT
01-14-2016, 11:53 AM
Al didn't know VBA :D

And he was smarter then me.

Paul_Hossler
01-14-2016, 05:01 PM
You know better than the inventor of E=mc2 ?


1. I did say it a matter of opinion

2. He was a physicist, not a programmer