Improve Multiple loop code

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............

Code:

---

        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

---

Code:

---

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

---

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'?

Code:

---

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

---

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:

Code:

---

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

---

@ Paul
If you're going for that Kind of speed, I would not use three references to the sheet

Code:

---

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

Code:

---

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

---

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:

Code:

---

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......

Quote:

---

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

---

Code:

---

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

---

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.....

Code:

---

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

---

To reduce the interaction with the worksheet, use:

Code:

---

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

---

Dave, snb's code will be extremely fast. Like, "If you blink, you'll miss it," fast.

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...........

Just remove or comment out 'option explicit'.

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 :

Code:

---

    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.

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.

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!

Quote:

---

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

Code:

---

Dim sn as Variant

---

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

You know better than the inventor of E=mc2 ?

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!

Al didn't know VBA :D

And he was smarter then me.

Quote:

---

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