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