[RESOLVED] Excel VBA - alternatives for loops?

[direktoren]

Hi guys

I just found out that one of my old macro's didn't do its job well enough. So I rewrote it - unfortunately I'm not that gifted at VBA, so now I need to charge the computer with a supernova if it should be able to process it!

I found I need a total of 5 nested for...next statements with the following counters:

For i = 5 To 250
    For j = i To i + 15
        For k = i To i + 15
            For l = 5 To 250
                For m = l To l + 15
                    If gSheet.Cells(i, 1).Value = "BFORR" Then
                        If gSheet.Cells(j, 2).Value = "Kundegrupper" Then
                            gSheet.Activate
                            gSheet.Rows(j).EntireRow.Copy
                            tSheet.Activate
                            tSheet.Rows(j).PasteSpecial

The code goes on like this, eventually to include k,l and m as well.

As I said - it takes literally ages (Don't know how long to be precise, but so far +3hours - I can do it manually in 1!)

Is there an alternative to for...next or can I make it leaner in a way??

/Nick

[si_the_geek]

It all depends on what you are trying to do..


Why do you need nested loop's? (I cant see any reason for it in your code)

Is there a need for PasteSpecial (as opposed to just a paste)? If not, we can speed that up a lot.

How are your variables declared?



It's probably best to explain what you want the code to do, and show us the code you have.

[Comintern]

.Activate, .Copy, and .Paste are horribly slow. One thing to try would be to do direct value assignments for the ranges. Can you post the full sub (or at least the nested loops)?

[direktoren]

Thanx for all the replies

I am aware that .activate, and copy paste takes up tons of time - but without activating the sheet I often occur errors!

'Code removed and put in next reply

Description of what I want to do:

gSheet - contains a report gotten from OLAP (so it is hierachicly structured)
tSheet - empty sheet, where I need a corrected copy of gSheet.

Contains:
gSheet;
column A - Contains a mainregistration number, for instance BFORR.
This coulmn is the "head" of the hierachy. lets Call them a,
b, c and d (in reality there are about 25)
Column B - contains the different groupings, which exist under the
given registration number, lets call them v,w,x,y and z.
Column C - Contains the actual data (numbers).

Problems;

- Not all of the variables (a-d and v-z) is included every time, so they should only be copied if they exist (logically)

- Some of the subgroupings (they are also listed in column B) are "misplaced", so they need to be subtracted from one group and then added to another, e.g. a minus c and b plus c. (but of course, only if there are existing!)

- some of the registration numbers should, if they exist, be added to other registration numbers, e.g. c plus d.

I hope this helps a bit! I know it would be easier if I could just upload the sheet, but its confidential - and I can't upload or download anything!

/Nick
P.s. The code which (almost) used to work for me is listed at another thread http://vbforums.com/showthread.php?p...47#post2472747

[direktoren]

Sub KngrOvfData()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim gSheet As Worksheet
Dim tSheet As Worksheet
Dim eSheet As Worksheet
 
    Set gSheet = ActiveWorkbook.Worksheets("Grund")
    Set tSheet = ActiveWorkbook.Worksheets("Tilrettet")
    Set eSheet = ActiveWorkbook.Worksheets("Ekskl.ny-øgede og tlf")
 
Application.ScreenUpdating = False
 
For i = 5 To 250
    For j = i To i + 15
        For k = i To i + 15
            For l = 5 To 250
                For m = l To l + 15
                    If gSheet.Cells(i, 1).Value = "BFORR" Then
                        If gSheet.Cells(j, 2).Value = "Kundegrupper" Then
                            gSheet.Activate
                            gSheet.Rows(j).EntireRow.Copy
                            tSheet.Activate
                            tSheet.Rows(j).PasteSpecial
                            Application.CutCopyMode = False
                        End If
                        If gSheet.Cells(j, 2).Value = "Mindre Erhverv" Then
                            gSheet.Activate
                            gSheet.Rows(j).EntireRow.Copy
                            tSheet.Activate
                            tSheet.Rows(j).PasteSpecial
                            Application.CutCopyMode = False
                            If gSheet.Cells(k, 2).Value = "04 Fonde/investeringsselskaber" Then
                                gSheet.Activate
                                gSheet.Range(Cells(k, 3), Cells(k, 3).End(xlToRight)).Copy
                                tSheet.Activate
                                tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                Application.CutCopyMode = False
                            End If
                            If gSheet.Cells(k, 2).Value = "Ukendt" Then
                                gSheet.Activate
                                gSheet.Range(Cells(k, 3), Cells(k, 3).End(xlToRight)).Copy
                                tSheet.Activate
                                tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                Application.CutCopyMode = False
                            End If
                        End If
                        '....top code repeats a couple of times, and then gets to the "bit more advanced part".
                    If gSheet.Cells(i, 1).Value = "Z3684 BANKAKT BG BANK" Then
                        If gSheet.Cells(j, 2).Value = "Kundegrupper" Then
                            gSheet.Activate
                            gSheet.Rows(j).EntireRow.Copy
                            tSheet.Activate
                            tSheet.Rows(j).PasteSpecial
                            Application.CutCopyMode = False
                            If gSheet.Cells(l, 1).Value = "N3394 CENTRAL INKASSO BG" And gSheet.Cells(m, 2).Value = gSheet.Cells(j, 2).Value Then
                                gSheet.Activate
                                gSheet.Range(Cells(m, 3), Cells(m, 3).End(xlToRight)).Copy
                                tSheet.Activate
                                tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                Application.CutCopyMode = False
                            End If
                            If gSheet.Cells(l, 1).Value = "3472 Hensættelser BG" And gSheet.Cells(m, 2).Value = gSheet.Cells(j, 2).Value Then
                                gSheet.Activate
                                gSheet.Range(Cells(m, 3), Cells(m, 3).End(xlToRight)).Copy
                                tSheet.Activate
                                tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                Application.CutCopyMode = False
                            End If
                        End If
                        If gSheet.Cells(j, 2).Value = "Mindre Erhverv" Then
                            gSheet.Activate
                            gSheet.Rows(j).EntireRow.Copy
                            tSheet.Activate
                            tSheet.Rows(j).PasteSpecial
                            Application.CutCopyMode = False
                            If gSheet.Cells(l, 1).Value = "N3394 CENTRAL INKASSO BG" And gSheet.Cells(m, 2).Value = gSheet.Cells(j, 2).Value Then
                                gSheet.Activate
                                gSheet.Range(Cells(m, 3), Cells(m, 3).End(xlToRight)).Copy
                                tSheet.Activate
                                tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                Application.CutCopyMode = False
                            End If
                            If gSheet.Cells(l, 1).Value = "3472 Hensættelser BG" And gSheet.Cells(m, 2).Value = gSheet.Cells(j, 2).Value Then
                                gSheet.Activate
                                gSheet.Range(Cells(m, 3), Cells(m, 3).End(xlToRight)).Copy
                                tSheet.Activate
                                tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                Application.CutCopyMode = False
                            End If
                            If gSheet.Cells(k, 2).Value = "04 Fonde/investeringsselskaber" Then
                                gSheet.Activate
                                gSheet.Range(Cells(k, 3), Cells(k, 3).End(xlToRight)).Copy
                                tSheet.Activate
                                tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                Application.CutCopyMode = False
                                If gSheet.Cells(l, 1).Value = "N3394 CENTRAL INKASSO BG" And gSheet.Cells(m, 2).Value = gSheet.Cells(k, 2).Value Then
                                    gSheet.Activate
                                    gSheet.Range(Cells(m, 3), Cells(m, 3).End(xlToRight)).Copy
                                    tSheet.Activate
                                    tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                    Application.CutCopyMode = False
                                End If
                                If gSheet.Cells(l, 1).Value = "3472 Hensættelser BG" And gSheet.Cells(m, 2).Value = gSheet.Cells(k, 2).Value Then
                                    gSheet.Activate
                                    gSheet.Range(Cells(m, 3), Cells(m, 3).End(xlToRight)).Copy
                                    tSheet.Activate
                                    tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                    Application.CutCopyMode = False
                                End If
                            End If
                            If gSheet.Cells(k, 2).Value = "Ukendt" Then
                                gSheet.Activate
                                gSheet.Range(Cells(k, 3), Cells(k, 3).End(xlToRight)).Copy
                                tSheet.Activate
                                tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                Application.CutCopyMode = False
                                If gSheet.Cells(l, 1).Value = "N3394 CENTRAL INKASSO BG" And gSheet.Cells(m, 2).Value = gSheet.Cells(k, 2).Value Then
                                    gSheet.Activate
                                    gSheet.Range(Cells(m, 3), Cells(m, 3).End(xlToRight)).Copy
                                    tSheet.Activate
                                    tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                    Application.CutCopyMode = False
                                End If
                                If gSheet.Cells(l, 1).Value = "3472 Hensættelser BG" And gSheet.Cells(m, 2).Value = gSheet.Cells(k, 2).Value Then
                                    gSheet.Activate
                                    gSheet.Range(Cells(m, 3), Cells(m, 3).End(xlToRight)).Copy
                                    tSheet.Activate
                                    tSheet.Range(Cells(j, 3), Cells(j, 3).End(xlToRight)).PasteSpecial Paste:=xlValues, operation:=xlAdd
                                    Application.CutCopyMode = False
                                End If
                            End If
                        End If
                    End If
                Next m
            Next l
        Next k
    Next j
Next i
 
'The code has been sharply reduced to meet the 10000 character limit - but it should contain a little bit of everything like this.
 
End Sub

[si_the_geek]

A few things I can say for a rapid speed-up:

1. Is there always a need for PasteSpecial (as opposed to just a paste)? If not, we can speed that up a lot. eg:
   

   gSheet.Activate
                               gSheet.Rows(j).EntireRow.Copy
                               tSheet.Activate
                               tSheet.Rows(j).PasteSpecial
                               Application.CutCopyMode = False

   can become:
   

   gSheet.Rows(j).EntireRow.Copy tSheet.Rows(j)

2. Change your variables from Integer to Long. Long is a 32-bit integer, (rather than 16 bit) which is faster, as that is what the processor uses.
3. When you are testing the same cell for multiple values, use a select case - as that only reads the cells (which is slow) once. It is also much easier to read. For example, this:
   

   If gSheet.Cells(k, 2).Value = "04 Fonde/investeringsselskaber" Then
   ...
                               End If
                               If gSheet.Cells(k, 2).Value = "Ukendt" Then
   ..
                               End If

   would become this:
   

   Select Case gSheet.Cells(k, 2).Value 
                               Case "04 Fonde/investeringsselskaber"
   ...
                               Case "Ukendt"
   ..
                               End Select

4. The big one... You should not run a loop unless it is needed. Obvious ones are the "m" and "l" loops - they are only used (in what you posted) if the first column contains "Z3684 BANKAKT BG BANK", so they should only be inside that (I also dont understand these loops to be honest, it's hard to read the code at the moment!).
   
   If the row doesn't contain "Z3684 BANKAKT BG BANK", your code will be almost 4000 times faster.

If you expand on these points enough, you should end up with code more like this:

For i = 5 To 250
  Select Case gSheet.Cells(i, 1).Value
  Case "BFORR"
    For j = i To i + 15
      Select Case gSheet.Cells(j, 2).Value
      Case "Kundegrupper"
          '<copy>
      Case "Mindre Erhverv"
          '<copy>
          For k = i To i + 15
            Select Case gSheet.Cells(k, 2).Value
            Case "04 Fonde/investeringsselskaber"
                '<copy>
            Case "Ukendt"
                '<copy>
            End Select
          Next k
      End Select
    Next j
  Case "Z3684 BANKAKT BG BANK"
    For j = i To i + 15
      Select Case gSheet.Cells(j, 2).Value
      Case "Kundegrupper"

Depending on the data, this should take the time from 3+ hours to less than a couple of minutes.

[direktoren]

Thanx Si

Wow - I'm really learning something here...The copy line - never seen it before! excellent...

I had heard about the cases, but didn't really know the difference between them and if statements, so I'll be working with them a lot more now!

Another question though.

I found that the following limitation for j;

For j = i To i + 15

isn't useful after all. I need it to be a bit more flexible.

is it possible to do something like this;

-first add a blank row before every cell in column B with the value "Kundegrupper", since this is always present as the first grouping of the registration number (this i actually know hw to do! )

- then define j something like:

For j = i To gSheet.Cells(i, 2).End(xlDown)

This doesn't work - but something like it? so I will be able to vary the length of the search loop...

Thanx
Nick

[Comintern]

This code returns a Range:

gSheet.Cells(i, 2).End(xlDown)

To make it work, you need to just get the row number from the returned range:

For j = i To gSheet.Cells(i, 2).End(xlDown).Row

[direktoren]

Excellent

Works like a peach - although i can't help slamming my head to the table - tried the range, the range value, rows.count.

Anyways thanks a lot, now I can get back to work!

Nick

[si_the_geek]

Good stuff.

Is it now taking a decent amount of time, or would you like it to be even faster? (I've got a few more speed improvements if you want them!).

[direktoren]

thanks, but no...

that won't be necessary - with end formatting and everything it only takes 4,6 seconds to run - so its 782 times faster than me doing it manually...

One thing I would like some help with though! On my raw data sheet (taken from OLAP) I've got a lot of red and blue arrows. Can I remove them via code or do I have to do it manually? I don't know how to tackle it since the arrows are "on top" of the cells...

[si_the_geek]

Excellent news on the timing.

It's definitely possible to remove the arrows, as you can do almost anything with code that you can do manually. To find out how to do this, I just created a macro (of me deleting an arrow manually), which gave me this code:

ActiveSheet.Shapes("Line 1").Select
    Selection.Delete

..which is actually the same as this (by removing the Select/Selection):

ActiveSheet.Shapes("Line 1").Delete

..with a minor bit of fiddling this can be turned into a loop to remove all shapes that have a name starting with "Line " (note that you can remove the If/End If to delete all drawing objects):

Dim objShape As Shape
 
  For Each objShape In ActiveSheet.Shapes
    If Left(objShape.Name, 5) = "Line " Then
     objShape.Delete
    End If
  Next objShape