0

Coming back from the holidays I find myself quite motivated to speed up the VBA Code I wrote last year. The basic data is a list of measures the company did or wants to do. My job was to create a macro to make it easier for some of the employees to get certain information out of the very uncomfortable list.

In the beginning I was quite new to VBA but learned the basics quite fast. The Problem now is, that some of the procedures take too long. Most of the time, actually throughout the whole program, I use some things that I know are making the macro slower but, that's where I will need your help, I just dont know how to make better.

For example:

There is a UserForm which is supposed to provide a simple way to export a filtered list. Til now I'm letting the employee choose what he wants to filter, then I filter the list by using the autofilter and proceed by copying the visible cells to another Worksheet. Obviously I use some things like the autofilter that make a macro severely slower than using arrays for example.

Edit: Some example code. It's kinda hard because I'm using many moduls and functions because it's quite a big project but I'll try to show you. I hope you understand it because the names and variables are german obviously.

Thats the Code where I call the function that uses autofilter to filter the Excel sheet I was talking about.

'Firma = company
If .chkFirma.Value = True Then
    Call Maßnahmen.FilterAnlegen(Spalte:=Maßnahmen.SpalteFirma, Kriterium:=Firma)
    Call DateiBenennen("-" & Firma)
End If
'Anlass = something like "reason"
If .chkAnlass.Value = True Then
    Call Maßnahmen.FilterAnlegen(Spalte:=Maßnahmen.SpalteAnlass, Kriterium:=Anlass)
    Call DateiBenennen("-" & Anlass)
End If
'Spezifizierung = specification
If .chkSpezifizierung.Value = True Then
    Call Maßnahmen.FilterAnlegen(Spalte:=Maßnahmen.SpalteSpezifizierung, Kriterium:=Spezifizierung)
    Call DateiBenennen("-" & Spezifizierung)
End If
'Kunde = customer
If .chkKunde.Value = True Then
    Call Maßnahmen.FilterAnlegen(Spalte:=Maßnahmen.SpalteKunde, Kriterium:=Kunde)
    Call DateiBenennen("-" & Kunde)
End If

Here the Function FilterAnlegen:

Sub FilterAnlegen(Spalte As Integer, Optional Kriterium As String, Optional Kriterien As Collection)
    Dim KritArray()
    If Kriterien Is Nothing And Kriterium = "" Then Exit Sub
    With Maßnahmen
        .Activate
        If Not Kriterien Is Nothing Then
            ReDim KritArray(Kriterien.Count - 1)
            For i = 0 To Kriterien.Count - 1
                KritArray(i) = Kriterien(i + 1)
            Next i
            'Filter anlegen
            .ListObjects("TabelleMaßnahmen").Range.AutoFilter Field:=Spalte, Criteria1:=KritArray, Operator:=xlFilterValues
        ElseIf Kriterium <> "" Then
            .ListObjects("TabelleMaßnahmen").Range.AutoFilter Field:=Spalte, Criteria1:=Kriterium
        End If
    End With
End Sub

My question is basically wheather arrays would be the best solution for this and how you would solve this. But some other questions are coming along with this. Since this is a Excel sheet over multiple columns I would need a multidimensional array. Is this slower than a one dimensional one?

If there is anything you don't understand or some things I need to clarify just ask for it.

I apologize for any spelling or grammar mistakes. I'm from germany thus not a native speaker so I'm hoping you can forgive me :)

Thanks in advance for all your help!

Edit: If someone is interested: I measured the time I needed for a simple makro with a code that uses ranges and copying and the recordset. While the range stuff took 0,26s the recordset made it in 0,08s which is incredible. Thats 3 times the speed.

Thanks for all of your help! :)

I actually tried a very different approach now than the recordset. The problem is that I'm really not understanding the recordset completely and therefore can't program the things I need at the moment. My Idea now was to approach it in a object orientated way. I know its hard in VBA to keep it going throughout the program but it just makes it so much easier to understand. I'll post you a class I created which is sadly not working yet. 

Option Explicit
'Array in dem die übergebenen Filter gespeichert werden
Dim filter()
'Konstruktor
Private Sub Class_Initialize()
    ReDim filter(0, 2)
End Sub
'Prüft, ob Filter in übergebener Zeile übereinstimmt.
Function IsValidLine(originalArray(), row) As Boolean
    Dim i As Integer
    IsValidLine = True
    'Durchläuft Filter und vergleicht diesen mit übergebener Zeile
    For i = 1 To UBound(filter)
        'Wenn Filter einmal nicht übereinstimmt wird Function verlassen
        If Not originalArray(row, filter(i, 1)) = filter(i, 2) Then
            IsValidLine = False
            Exit Function
        End If
    Next i
End Function
'Kopiert die übergebene Zeile des ungefilterten Arrays in das Gefilterte
Sub CopyLine(Zeile As Integer, originalArray, ByRef newArray)
    Dim i As Integer
    'Gefiltertes Array wird um eine Zeile erweitert
    ReDim newArray(1 To UBound(newArray) + 1, 1 To UBound(originalArray, 2))
    'Kopieren
    For i = 1 To UBound(originalArray, 2)
        newArray(UBound(newArray), i) = originalArray(Zeile, i)
    Next i
End Sub
'Function, um Filter zur Klasse hinzuzufügen
Sub Add(Spalte As Integer, Kriterium)
    'Filterarray wird um eine Zeile erweitert und Spalte und Kriterium
    'des neuen Filters werden in diese eingetragen
    ReDim filter(1 To UBound(filter) + 1, 1 To 2)
    filter(UBound(filter), 1) = Spalte
    filter(UBound(filter), 2) = Kriterium
End Sub
'Aktueller Filter wird angewendet um das übergebene Array mit diesem zu
'Filtern und ein neues, gefiltertes Array zurückzugeben
Function getFilteredArray(originalArray())
    Dim i As Integer, j As Integer
    Dim newArray()
    ReDim newArray(1 To 1, 1 To UBound(originalArray, 2))
    'Durchläuft alle Zeilen des übergebenen Arrays
    For i = 1 To UBound(originalArray, 1)
        'Wenn eine Zeile mit dem Filter übereinstimmt wird sie in das
        'gefilterte Array übernommen
        If IsValidLine(originalArray, i) Then
            'Zeile, die übereingestimmt hat, wird kopiert
            CopyLine i, originalArray, newArray
        End If
    Next i
    'NewArray als gefiltertes Array zurückgeben
    getFilteredArray = newArray
End Function

There are no syntax mistakes it's all logical. Well the goal is to get an array out of the "getFilteredArray" thats similar to what I would get from using the autofilter.

Thanks for all of your input and please don't think I'm not appreciating the recordset stuff but I just dont have the time to look deeper into it atm. As far as I read it from some articles and blogs the recordset is usually used in access? and what makes it hard for me aswell is that there is not intellisense and when I am completely new to something it helps me a lot most of the times.

At the moment the getFilteredArray method gives me an array with 606 lines (which is correct) but only the last one has values. all other ones are empty. I'm not sure what the problem is hence the question :P

Improve this question
4
  • 1
    Can you show us your code? It is rather difficult to guess at what might be faster. In general arrays are quicker... but not always, thus some of the code would be helpful. You may be able to speed up the execution by doing something as simple as adding Application. Application.ScreenUpdating = False Commented Jan 9, 2017 at 7:34
  • msdn.microsoft.com/en-us/library/office/ff821260.aspx turning off while modifying, back on at the end Commented Jan 9, 2017 at 7:59
  • but why would this make the code faster? there are no formulars in there or does this also count for the autofilter? Commented Jan 9, 2017 at 8:36
  • There are several things to consider to speed up your code. If your code select cells instead using their references, it will certainly slow down a lot, so it is something to verify at first. If your code does a lot of looping, it will slow down too. If your code does loop to find a value in a column, you can change your code to use Find method instead. Commented Jan 9, 2017 at 11:41

2 Answers 2

Reset to default
1

You question is not specific enough.

If you want general VBA Speed up tips - read my article here.

I think you might be interested in the QueryTables in Excel (SQL in Excel) to be able to run filtering on multiple worksheets or against multiple columns - see my tutorial here.

Otherwise you need to show us a specific procedure for more precise speed up tips.

Improve this answer
Sign up to request clarification or add additional context in comments.

3 Comments

I dont really know how since the project is so big that I definitly can't put the whole thing up here. My Question is just wheather it would make sense to put something like my list into an array. Would it make the program faster and easier to handle or rather worse?
Using an array can help, but I don't think it is the main issue. Check if you use ´Select` or use loops with ´ActiveCell` to work your list, they certainly degrade performance and an array will speed up considerably.
When I find the time I will read through the article, it looks quite helpful! I'm almost never using select since I do know that it makes it very slow. I got to admit that I'm using it once in this program because I didn't find a way to copy a picture in a different way.
0

Consider using a recordset instead of multidimensional arrays. The i.m.o. easiest way of using them in Excel is shown here.

i. add this function

Function GetRecordset(rng As Range) As Object

    'Recordset ohne Connection:
    'https://usefulgyaan.wordpress.com/2013/07/11/vba-trick-of-the-week-range-to-recordset-without-making-connection/

    Dim xlXML As Object
    Dim rst As Object

    Set rst = CreateObject("ADODB.Recordset")
    Set xlXML = CreateObject("MSXML2.DOMDocument")
    xlXML.LoadXML rng.Value(xlRangeValueMSPersistXML)

    rst.Open xlXML

    Set GetRecordset = rst

End Function

ii. the following should give you an idea of how to use recordsets for data operations

Sub testrecordset()

    Dim rs As Object
    Set rs = GetRecordset(ThisWorkbook.Sheets(1).UsedRange)

    With rs

        Debug.Print .RecordCount

        ' how to set a filter
        .Filter = "FirstName = 'Henry'"
        Debug.Print .RecordCount

        ' how to remove a filter
        .Filter = vbNullString

        ' how to output headers
        Dim i As Integer: i = 1
        Dim fld As Object

        For Each fld In .Fields
            ThisWorkbook.Sheets(2).Cells(1, i).Value = fld.Name
            i = i + 1
        Next fld

        ' how to output filtered data
        ThisWorkbook.Sheets(2).Cells(2, 1).CopyFromRecordset rs

        ' how to loop individual records and access individual fields
        While Not .EOF
            Debug.Print !FirstName & vbTab & !IntValue
            .MoveNext
        Wend

    End With

End Sub

Note:

  • if you want to loop the recordset repeadedly (e.g. you set a filter, loop all records, set another filter, loop all records again), you have to .MoveFirst before looping again, so your next loop starts at the first record again

  • since this can be a bit daunting the first time you set it up, i suggest you post the code of FilterAnlegen and we go on from there

  • if there are any rows above your actual header row, Excel can have trouble when determining the correct headers in rng.Value(xlRangeValueMSPersistXML) as I described here, concatinating two rows instead of just using one row (e.g. field names have leading blanks with an empty row). Possible fixes:

    a) starting at Row(1)

    b) replacing blanks in the XML before passing it to the DOMDocument xlXML.LoadXML Replace(rng.Value(xlRangeValueMSPersistXML), "rs:name="" ", "rs:name=""")

    c) include the blanks when referencing Field.Name in code

Improve this answer

16 Comments

Thank you very much, I guess that this is a rather professional way of solvíng this, but it doesn't seem too complicated to me. I will try this out and will come back to you with further questions or my code to let you look through it.
I added the function in my original post. I do know that my solution is not very good but as I stated I just didn't know a better one.
Using Recordsets how do I set the names of the fields so the headers basically? When I print the names of the fields i just get field1, field2 etc. Edit: I got the answer... I used "UsedRange" as parameter but the first couple of rows are empty so after using the range in which I actually had data I got the headers I wanted
Set rs = GetRecordset(maßnahmen.ListObjects("TabelleMaßnahmen").Range) references your Table and should work for you. Note that there can be a problem if your data does not start in Row(1) (see edited Note 3 + Link). Have you got leading blanks in your Field.Names, e.g. " Vorname" instead of "Vorname"? A quick and dirty solution would be to either a) add the missing blanks in your code when referencing the Fields or b) remove the Rows above TabelleMaßnahmen
I figured that the field name wasnt correct (its "Status 100%"). could the problem be the space? but when i take a look at the actual field name in the way you showed me it shows the name WITH the space Solved: Had to put it into []
|

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.