'range1.value = range2.value Very slow VBA

I'am writing simple code like nextCell.Value = dateJour.Value, were dateJour is a date located in a cell in the workbook.

When I loop (about 100 times) it takes forever because each nextCell.Value = dateJour.Value statement in the AddData procedure takes 0.2 seconds.

Same for .Range(nextCell.Offset(0, 1), nextCell.Offset(0, 8)).Value = wsSaisie.Range("A" & rowNumber, "H" & rowNumber).Value

The AddData procedure is called by fillData procedure and this is where the loop occurs.

It checks if the filled data by the user already exists in the data sheet called "Données". If not it adds data to the sheet (by calling AddData), if yes it modifies the data (by calling ChangeData). It goes/checks line by line because sometimes data has to be added or modified.

Thanks a lot for your help to improve my code !

Public Sub FillData()
    
Dim wsSaisie As Worksheet
    Set wsSaisie = ThisWorkbook.Worksheets("Saisie")
    
    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("Données")
    
    Dim lastRow As Long, lastColumn As Long
    lastRow = wsSaisie.Range("A:H").Find("*" _
        , LookAt:=xlPart _
        , LookIn:=xlFormulas _
        , SearchOrder:=xlByRows _
        , SearchDirection:=xlPrevious).Row
    
    Dim rowKey As String
    Dim foundRowNumber As Long
    
    Dim cell As Range
    For Each cell In wsSaisie.Range(wsSaisie.Range("I5"), wsSaisie.Range("I" & lastRow))
        rowKey = cell.Value
        foundRowNumber = DataAlreadyExists(rowKey)
    
        If foundRowNumber = -1 Then
            Call AddData(cell.Row)
        Else
            Call ChangeData(foundRowNumber, cell.Row)
        End If
    Next cell
End Sub
Public Sub AddData(rowNumber As Long)

    Dim wsSaisie As Worksheet
    Set wsSaisie = ThisWorkbook.Worksheets("Saisie")

    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("Données")

    Dim dateJour As Range
    Set dateJour = wsSaisie.Range("B1")

    Dim nextCell As Range
    Set nextCell = wsData.Range("A1048576").End(xlUp).Offset(1, 0)
    
    'StartTime = Timer
    nextCell.Value = dateJour.Value
    'Debug.Print Round(Timer - StartTime, 2)
    
    wsData.Range(nextCell.Offset(0, 1), nextCell.Offset(0, 8)).Value = wsSaisie.Range("A" & rowNumber, "H" & rowNumber).Value

End Sub

Public Sub ChangeData(rowTo As Long, rowFrom As Long)

    Dim wsSaisie As Worksheet
    Set wsSaisie = ThisWorkbook.Worksheets("Saisie")

    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("Données")
    
    wsData.Range("G" & rowTo & ":" & "I" & rowTo).Value = wsSaisie.Range("F" & rowFrom & ":" & "H" & rowFrom).Value
End Sub

Public Function DataAlreadyExists(key As String) As Long

    Dim wsData As Worksheet
    Set wsData = ThisWorkbook.Worksheets("Données")
    
    If Not IsError(Application.Match(key, wsData.Range("K:K"), 0)) Then
        DataAlreadyExists = Application.Match(key, wsData.Range("K:K"), 0)
    Else
        DataAlreadyExists = -1
    End If
End Function


Solution 1:[1]

Use Value2 instead of Value (ref.)

i.e. in AddData()

nextCell.Value2 = dateJour.Value2

and

nextCell.Offset(0, 1).Resize(1, 8).Value2 = wsSaisie.Cells(rowNumber, 1).Resize(1, 8).Value2

Also, in your DataAlreadyExists() function, you evaluate MATCH twice when data do exist, e.g. consider this

Public Function DataAlreadyExists(key As String) As Long

    Dim wsData As Worksheet, resultat as Variant
    Set wsData = ThisWorkbook.Worksheets("Données")
    
    resultat = Application.Match(key, wsData.Range("K:K"), 0)
    If Not IsError(resultat) Then
        DataAlreadyExists = resultat
    Else
        DataAlreadyExists = -1
    End If
End Function

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Spectral Instance