Search code examples
vbaperformanceexcelprocessing-efficiency

Slow vlookup and countifs


I am trying to fill a table with the count of how many registers I have, having the same day, week and hour, and that count divided in the number of years in which I can find the same week.

I've done this code in VBA but it's really slow, so if you can help me to improve this solution, I will really appreciate it.

    Sub formulacion()
    Dim a As Integer
    Dim b As Integer
    Dim years As Integer
    Dim rango_semana As Range
    Dim rango_dia As Range
    Dim rango_hora As Range
    Dim rango_sede As Range
    Dim rango_busqueda As Range



    a = 2
    For a = 2 To 319
        If Sheets("Dinamicos").Cells(5, a) <> "" Then
        b = 6
            For b = 6 To 20

            semana = Sheets("Dinamicos").Cells(3, a)
            dia = Sheets("Dinamicos").Cells(5, a)
            hora = Sheets("Dinamicos").Cells(b, 1)
            sede = Sheets("Dinamicos").Cells(4, 1)
            LastRow = Sheets("Base").Cells(Sheets("Base").Rows.Count, "A").End(xlUp).Row
            Set rango_semana = Sheets("Base").Range("AK2:AK" & LastRow)
            Set rango_dia = Sheets("Base").Range("AG2:AG" & LastRow)
            Set rango_hora = Sheets("Base").Range("AJ2:AJ" & LastRow)
            Set rango_sede = Sheets("Base").Range("J2:J" & LastRow)
            Set rango_busqueda = Sheets("Base").Range("AK2:AN" & LastRow)

            lookupvalue = Application.VLookup(semana, rango_busqueda, 4, False)
               If IsError(lookupvalue) Then
               years = 1
              'Si lo encuentra lo devuelve
               Else
               years = lookupvalue
               End If

            Sheets("Dinamicos").Cells(b, a) = (WorksheetFunction.CountIfs(rango_semana, semana, rango_dia, dia, rango_hora, hora, rango_sede, sede)) / years

            Next b
        End If
        b = 6
  Next a


  End Sub

Solution

  • Some of the var assignments change within the nested For ... Next loop iterations; others do not. Don't keep reassigning vars that do not change.

    Application.Match is faster than Application.Vlookup.

    You do not have to set and reset the values in a and b before using them in the loop and nested loop. They are assigned their start value upon entering the loop(s).

    lastRow = Worksheets("Base").Cells(Worksheets("Base").Rows.Count, "A").End(xlUp).Row
    Set rango_semana = Worksheets("Base").Range("AK2:AK" & lastRow)
    Set rango_dia = Worksheets("Base").Range("AG2:AG" & lastRow)
    Set rango_hora = Worksheets("Base").Range("AJ2:AJ" & lastRow)
    Set rango_sede = Worksheets("Base").Range("J2:J" & lastRow)
    Set rango_busqueda = Worksheets("Base").Range("AK2:AN" & lastRow)
    sede = Worksheets("Dinamicos").Cells(4, 1)
    
    For a = 2 To 319
        If Worksheets("Dinamicos").Cells(5, a) <> "" Then
            semana = Worksheets("Dinamicos").Cells(3, a)
            dia = Worksheets("Dinamicos").Cells(5, a)
    
            For b = 6 To 20
    
                hora = Sheets("Dinamicos").Cells(b, 1)
    
                lookupvalue = Application.Match(semana, rango_busqueda.Columns(1), False)
                If IsError(lookupvalue) Then
                   years = 1
                  'Si lo encuentra lo devuelve
                Else
                   years = rango_busqueda.Cells(lookupvalue, 4).Value2
                End If
    
                Worksheets("Dinamicos").Cells(b, a) = (WorksheetFunction.CountIfs(rango_semana, semana, rango_dia, dia, rango_hora, hora, rango_sede, sede)) / years
    
            Next b
        End If
    Next a
    

    Finally, remember that Sheets is not the same as Worksheets.