# Slow performance in looping and filling missing data

I wrote some code that loops for specific data and then fills the missing cells in another sheet. The code works perfectly but it takes too much time to fill the missing cells (values).

What I tried to do is to Test if Cell B is blank or not , then I created 2 variables :

• x for activesheet values which need to be filled and

• y for sheet 1 (source) and keep comparing until x match y to take the value in front of the specific data.

The code I came up with:

  Sub TraiterNoms()
Application.ScreenUpdating = False
Dim i As Variant
Dim CompareRange As Variant
Dim x As Variant
Dim y As Variant
Dim derlignE As Variant
Dim derlignC As Variant

derlignE = Range("A" & Rows.Count).End(xlUp).Row
derlignC = Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Row
Set CompareRange = Sheets("Feuil1").Range("A:A").resize(derlignC, 1)

For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If Range("B" & i) = "" Then
For Each x In Range("A:A").resize(derlignE, 1)
For Each y In CompareRange
If x = y Then x.Offset(0, 1) = y.Offset(0, 1)
Next y
Next x
End If
Next i
Application.ScreenUpdating = True
End Sub


I feel like I could improve this code to make it more fluent. Would that be over-complicated?

• Comments are not for extended discussion; this conversation has been moved to chat. Feb 23 '18 at 22:49

## General Observations

Note: Feuil is this Excel version's name for Sheet.

What the OP's code does is assign the date of the last occurence of each Id in Feuil1 to the matching IDs on Feuil2. I assume that the OP is actually interested in the latest data because the data is sorted by data ascending.

It seems odd to that there are multiple occurrences of Ids on Feuil2. I assume that this is because the OP is still testing.

The OP stated that he is wants to "Test if Cell B is blank or not". The OP needed this to keep the last occurence of the ID from being overwritten. I handle this by saving the latest date associated with an ID in the Dictionary lookup.

## Performance

Collections are idea to lookup values associated with Ids in a list. The values are stored as Key/Value pairs. There are many kinds of Collection but Scripting Dictionaries are the easiest to use. I will provide example of using a Scripting Dictionary and a SortList in my code below.

Working with your data in an Array is far more efficient than working with a Range. You will receive a small performance boost by Reading the data from an Array and a huge boost by writing the data to the Range in one operation using an Array. Always remember that Reading data is a cheap operation and Writing data is relatively expensive in comparison.

Reference: Excel VBA Introduction Part 25 - Arrays

In my code below I do not bother to turn off Application.ScreenUpdating. Because I am using the lookups and more importantly writing the data in one operation from an Array to the worksheet is that fast.

## Example 1: Dictionary - Match IDs

In this example I store the latest date associated with an ID as a Key/Value pair in a dictionary. I then create an an array data2A to store the Ids to match and data2B to store the associated dates. Finally I write the associated dates data2B to the Feuil2 Column B.

Sub TraiterNoms1()
Dim data1 As Variant, data2A As Variant, data2B As Variant
Dim x As Long
Dim dic As Object, Source As Range
Set dic = CreateObject("Scripting.Dictionary")

With Worksheets("Feuil1")
data1 = .Range("A1:G1", .Range("B" & Rows.Count).End(xlUp))
'Add the latest date with the IDs on Sheet1 to the Dictionary
For x = 1 To UBound(data1)
key = data1(x, 1)
If dic.Exists(key) Then
If dic(key) < data1(x, 7) Then dic(key) = data1(x, 7)
Else
End If
Next
End With

With Worksheets("Feuil2")
Set Source = .Range("A1", .Range("A" & Rows.Count).End(xlUp))
data2A = Source.Value

ReDim data2B(1 To UBound(data2A), 1 To 1)
For x = 1 To UBound(data2A)
key = data2A(x, 1)
data2B(x, 1) = dic(key)
Next

Source.Offset(0, 1).Value = data2B

End With
End Sub


Example 2: Dictionary - Write Unique IDs and Matching Values to Feuil2

Sub TraiterNoms2()
Dim data1 As Variant
Dim x As Long
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")

With Worksheets("Feuil1")
data1 = .Range("A1:G1", .Range("B" & Rows.Count).End(xlUp))
'Add the latest date with the IDs on Sheet1 to the Dictionary
For x = 1 To UBound(data1)
key = data1(x, 1)
If dic.Exists(key) Then
If dic(key) < data1(x, 7) Then dic(key) = data1(x, 7)
Else
End If
Next
End With

With Worksheets("Feuil2")
.Columns("A:B").ClearContents
.Range("A1:B1").Value = Array("Items", "Latest Date")
.Range("A2").Resize(dic.Count).Value = Application.Transpose(dic.Keys)
.Range("B2").Resize(dic.Count).Value = Application.Transpose(dic.Items)
End With
End Sub


Example 3: SortedList - Write Sorted Unique IDs and Matching Values to Feuil2

Sub TraiterNoms3()
Dim data1 As Variant, data2AB As Variant
Dim x As Long
Dim sList As Object
Set sList = CreateObject("System.Collections.SortedList")

With Worksheets("Feuil1")
data1 = .Range("A1:G1", .Range("B" & Rows.Count).End(xlUp))
'Add the latest date with the IDs on Sheet1 to the Dictionary
For x = 1 To UBound(data1)
key = data1(x, 1)
If sList.Contains(key) Then
If sList(key) < data1(x, 7) Then sList(key) = data1(x, 7)
Else
End If
Next
End With

ReDim data2AB(1 To sList.Count, 1 To 2)

For x = 0 To sList.Count - 1
key = sList.getKey(x)
data2AB(x + 1, 1) = key
data2AB(x + 1, 2) = sList(key)
Next

With Worksheets("Feuil2")
.Columns("A:B").ClearContents
.Range("A1:B1").Value = Array("Items", "Latest Date")
.Range("A2").Resize(sList.Count, 2).Value = data2AB
End With
End Sub

• thank you for the explination but the problem here that your code is specific to deal with dates and also when for E.g there is an identical DATA in column 1 in Feuil1 it delete the repeated value and and take the related date in Feuil2 and that's not what I'm looking For :P however as you explained Scipting Dictionnaries is the easiest to reach the perfect result Feb 24 '18 at 7:43
• @POLOSTutorials Example 1 matches every entry. After reading your comments my code should be modified to load the data using Step -1 and use If not dic.Exists(key) Then dic.Add Key.value.
– user109261
Feb 24 '18 at 10:55
• do you mean something like this filedropper.com/stackoverflow if you could modify and return a link of the file :-) Feb 24 '18 at 11:18
• Download File. I modified the code using a slightly different technique. I use the dictionary to store the index of the last occurence of each ID. I then retrieve the index of the source array for each ID on Feuil2 and use it to fill a 2 Column array that is the written to Feuil2.
– user109261
Feb 25 '18 at 13:29
• I also added a header row to Feuil1 (of course I had to guess at the actual column names...lol). I did this to demonstrate how to use an Enumeration to return Column numbers. It is all pretty self explanatory I think that these techniques will be very useful to you in the future.
– user109261
Feb 25 '18 at 13:30

It looks like you just need VLookup. In column B1 of your active sheet you'll want =VLookup(A1,Feuil1!$A$1:$B$4,2,0). Make sure to edit Feuil1!$A$1:$B$4 to be the entire range you want. If your range is contiguous, no empty cells, Control+Shift+Down followed by Holding Shift+RightArrow ought to get you what you're after.

Edit: Below you'll find code that does what you're attempting.

The reason why your initial code is so slow is you have a loop For Each ... Next within another loop. Inside this is checking each and every single one. and must go through the both lists. If in your first loop (ActiveSheet) you have 10 entries and your second loop (Feuil1) you have 15 entries you have to compare 150 times. If either list grows it will get slower and slower. By refactoring you have the same outcome but achieved by a better, faster, way.

Strive for code that is self documenting. What is occurring should be apparent when you read it. Minimal effort should be needed to understand what is going on.

The code below has a main Sub that sets some variables and calls on functions to provide information to complete the required task.

Public Sub TraiterNoms()
Application.ScreenUpdating = False

Dim actSheet As Worksheet
Set actSheet = ActiveSheet

Dim sourceSheet As Worksheet
Set sourceSheet = ThisWorkbook.Worksheets("Feuil1")

Dim lastFormulaRow As Long
lastFormulaRow = actSheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim formulaRange As Range

On Error GoTo NoBlankCells
Set formulaRange = actSheet.Range(actSheet.Cells(1, 2), actSheet.Cells(lastFormulaRow, 2)).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

Dim lookupFormula As String
lookupFormula = GetLookupFormula(formulaRange, sourceSheet, 2)
formulaRange.Formula = lookupFormula
Dim subArea As Range
For Each subArea In formulaRange.Areas
subArea.Value2 = subArea.Value2
Next

CleanExit:
Application.ScreenUpdating = True
Exit Sub

NoBlankCells:
Resume CleanExit

End Sub

Private Function GetLookupFormula(ByVal depositRange As Range, ByVal lookupSheet As Worksheet, ByVal lookupColumn As Long) As String
Dim valueToMatch As String

Dim lookupCells As String
lookupCells = GetLookupCells(lookupSheet, lookupColumn)
GetLookupFormula = "=Vlookup(" & valueToMatch & "," & lookupCells & "," & lookupColumn & ",0)"
End Function

Private Function GetLookupCells(ByVal sourceSheet As Worksheet, ByVal lookupColumn As Long) As String
Dim lastRow As Long
lastRow = sourceSheet.Cells(Rows.Count, "B").End(xlUp).Row

Dim sourceRange As Range
Set sourceRange = sourceSheet.Range(sourceSheet.Cells(1, 1), sourceSheet.Cells(lastRow, lookupColumn))

GetLookupCells = sourceRange.Parent.Name & "!" & sourceRange.Address
End Function

• I can't limit myself with a specific range everytime I wanna to loop and fill . but I didn't understand the part of Control+Shift+Down and Shift+RightArrow Feb 23 '18 at 21:51
• @POLOSTutorials That finds last used row and column. You already have variables for last used row in each sheet. Feb 23 '18 at 22:00
• So you want the range to be dynamic whenever the code is run? Feb 23 '18 at 22:05
• Yes I want it to be dynamic and not only one column Feb 23 '18 at 22:06
• When I ran the OPs code it looked up the date (Column G) of the last occurence of the IDs on Feuil2. You code returned Column B of the first occurence.
– user109261
Feb 24 '18 at 7:11

All right, looking at your workbook I think what you're doing is looking up column A on Feuil2 on Feuil1 and if found, returning the date from Feuil1.

That's my assumption.

# Bottleneck

First,

For Each y In CompareRange


This is testing all 7 columns on Feuil1. I don't think you intend that, you only want to test column 1. It also carries on even if it's already found.

You also want the latest date from Feuil1, I think, because that's what is showing up for 205122681 - 11/8/2017 when Fueil1 has that number on rows 3 AND 18. It's giving row 18. Both times it searches that number.

So that's my assumption, given what it is actually doing.

### Performance

If I were to tell you only about performance, and you wanted to keep it in VBA, I'd say use arrays. I mean you could use a Dictionary, but that might be a bit of a jump from this to that.

So give yourself an array of what you want to lookup and an array of where to look it up. Arrays like this (it isn't perfect) -

Option Explicit
Public Sub GetDates()
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Set sourceSheet = Feuil1
Set targetSheet = Sheets("feuil2")
Dim lookUpArray As Variant
Dim populateArray As Variant
Dim lastRow As Long
Dim targetRange As Range
lastRow = targetSheet.Cells(Rows.count, 1).End(xlUp).Row
Set targetRange = targetSheet.Range(Cells(1, 1), Cells(lastRow, 2))
targetRange.Select
ReDim populateArray(1 To lastRow, 1 To 2)
Dim index As Long
Dim lookupIndex As Long
For index = 1 To lastRow
populateArray(index, 1) = Cells(index, 1)
Next

lastRow = sourceSheet.Cells(Rows.count, 1).End(xlUp).Row
ReDim lookUpArray(1 To lastRow, 1 To 2)
Dim count As Long
count = 1

For index = lastRow To 1 Step -1
If Not IsInArray(sourceSheet.Cells(index, 1), lookUpArray, count) Then
lookUpArray(count, 1) = sourceSheet.Cells(index, 1)
lookUpArray(count, 2) = sourceSheet.Cells(index, 7)
count = count + 1
End If
Next
Dim lookupValue As String
For index = LBound(populateArray) To UBound(populateArray)
lookupValue = populateArray(index, 1)
For lookupIndex = 1 To count
If lookUpArray(lookupIndex, 1) = populateArray(index, 1) Then
populateArray(index, 2) = lookUpArray(lookupIndex, 2)
Exit For
End If
Next
Next

targetRange = populateArray

End Sub

Private Function IsInArray(ByVal stringToBeFound As String, ByVal sourceArray As Variant, ByVal count As Long) As Boolean
Dim i
For i = LBound(sourceArray) To count
If sourceArray(i, 1) = stringToBeFound Then
IsInArray = True
Exit Function
End If
Next i
IsInArray = False

End Function


This takes 0 seconds to run. Now let's move on to your code.

### Indentation

I'm not sure if the indentation of the code went awry when pasted, but it's all off. The Sub should be at the first level and each new level should be indented 1 tab more than the previous level. Take a look at my code for example.

### Variables

  Dim i As Variant
Dim CompareRange As Variant
Dim x As Variant
Dim y As Variant
Dim derlignE As Variant
Dim derlignC As Variant


I think derlignC is an iterator, but I don't know what that is iterating. Either way, everything is a Variant when it seems like none of them need to be variants.

Variants are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

You're better off with Types:

• i, derlignC, derlignE = Long
• CompareRange, x, y = Range

Also, your naming is strange. If the single letters are iterators, tell me what they are iterating. A rowIndex or a columnIndex, be clear. It's free to name them anything you want, so take advantage of that.

And CompareRange should be compareRange, VBA naming has the first word lowercase to indicate a procedure level variable.

I didn't reuse any of your variable names.

### Working on the sheet

You are working directly on the sheet, constantly resizing ranges and really just doing everything you can to make this run slowly. This is because you probably don't know (yet) that is this incredibly slow.

The same principles as using .select apply - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on StackOverflow addressing this.

### Loops

When you have a bunch of loops where you loop through the same thing more than once, you probably want to look at refactoring. But in this case, since the data is static, just put it into an array and look in the array.

Also, no need to loop through cells you don't need to, e.g. all columns of CompareRange.

### Worksheet Names

I see you used the codename property of your sheets, great! For some reason I couldn't get VBA to recognize Feuil2 as a sheet, hence my extra variables. You were definitely on the right track here, except relying on activesheet.

When you rely on activesheet, you risk literally everything - you can't be sure what will be active. Always define your sheets. Never take anything for granted, always explicitly state your ranges e.e. Range("A1:A2") is implicitly on activesheet while targetSheet.Range("A1:A2") is absolutely on the target sheet.

### Refactoring and using functions

You'll see I used a single function to test the existence of a value in the array. You can tell by the name of the function what it's doing, which takes that function out of the main code and makes it easier to read.

You can also refactor. My code could be refactored for populating arrays. But, in the way that I wrote it, I'd need to rewrite how I know the size of the source array, so I didn't. That's just lazy of me, sorry.

### Explanation of my code

As you can probably see, my code does three things - 1. Creates an array that needs to be populated 2. Creates an array of unique lookup values 3. Compares the arrays

• Thank you for your answer but I your code works and give me last Date but when there is for E.g this value 205122681 repeated twice in row 3 and 18 i need to pull those data in Feuil2 infront of the first 205122681 a data row 3 and the other 205122681another data in row18 and I don't to be limited to work on date I need the other column :-) Feb 24 '18 at 8:00
• I told you what I assumed it was doing, what I saw it was doing. That's what I critiqued. Feb 24 '18 at 8:04
• Yes , as result your code is doing the same thing as my code but much more easier to understand and to manipulate :-) Feb 24 '18 at 8:08
• Good job. I made some notes on your code:Download Review. Your code has the advantage over mine of working on Macs. But I still prefer the simplicity and versatility of a using a Dictionary. +1 my friend
– user109261
Feb 24 '18 at 8:12

As already pointed out by other contributors here, the main issues are:

• you are looping unnecessarily through all record of column A

• you're both reading and, what's more important, writing a lot of times

so all answers given before provide patterns to avoid or at least limit those issues impact

On my part I concentrated on:

• avoid looping at all

• reducing writing to some one-shot statement

so I use SpecialCells(xlCellTypeBlanks) method to reference blank cells only where to write a lookup formula of which finally leave only values

and here's the outcome (with further explanations in comments):

Option Explicit

Sub TraiterNoms()
Dim rng As Range
With Worksheets("Feuil1") 'reference "source" sheet
Set rng = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) 'set its column A range from row 1 down to last not empty one
End With

With Worksheets("Target") ' reference "target" sheet (change "Target" to your actual target sheet name)
With .Range("B1:B" & .Cells(.Rows.Count, 1).End(xlUp).row) 'reference its column B range from row 1 down to last not empty one
If WorksheetFunction.CountBlank(.Cells) > 0 Then ' if any blank cell in referenced range. this check to avoid error thrown by subsequent statament
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=index(Feuil1!" & rng.Offset(, 1).Address(, , xlR1C1) & ",match(RC[-1],Feuil1!" & rng.Address(, , xlR1C1) & ",0))" 'fill blank cells with a lookup (well, sort of) formula
.Value = .Value 'get rid of formulas and leave values only
End If
End With
End With
End Sub


which:

• on a 30k rows data with 10% of column B blanks took some 2 seconds to run

• on a 30k rows data with 50% of column B blanks took some 13 seconds to run

• thank you for the explanation +1 my friend but how to manage the other columns you are here only refering to one column which is B Feb 24 '18 at 23:05
• Not sure to understand you: can you be more explicit? Feb 24 '18 at 23:06
• sorry but how can I fill the other columns in my file I got more than 1 column at least 3 to loop and fill Feb 24 '18 at 23:07
• Am I wrong or you did mention only columns A and B in your question and attached code? Anyway you can easily tweak my code to account for columns C (and D and so on) also: just duplicate theWith .Range("B1:B" & .Cells(.Rows.Count, 1).End(xlUp).row)... End With block and change 1) B to C (and D and so on) 2)rng.Offset(, 1) to rng.Offset(, 2) (and 3 and so on) 3) RC[-1] to RC1. And consider marking answer as accepted if it solved your original question. Thank you Feb 24 '18 at 23:15
• the tric of my code that I mentionned A and B but when he find a match between column A in target sheet and column A in source sheet , it copy the columns C and D it depend in what Value I put in this line (derlignC, 1) and (derlignE, 1) Feb 24 '18 at 23:21