How do I transfer large ranges into memory first, then do the comparison vs memory instead of by a cell range?

[Tardisgx]

The below macro clears cells that do not match with the D column range. The issue is my required ranges are too large for the macro to run on my computer.

Sub REMOVEPIDS()Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False


Dim Rng As Range, Dn As Range
Set Rng = Range("D2:D35525") 'Range to match against


With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

For Each Dn In Rng: .Item(Dn.Value) = Empty: Next

Set Rng = Range("F2:DVF62601") ' Range to clear

For Each Dn In Rng
If Not .exists(Dn.Value) Then Dn.ClearContents
Next Dn

End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub

 

[Fluff]

Do you have any formulae in the range F2:DVF62601?

 

[Tardisgx]

No this is all classified as text

 

[Fluff]

In that case you can try this

Sub REMOVEPIDS()
   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False
   Application.DisplayStatusBar = False
   Application.EnableEvents = False
   
   
   Dim Rng As Range, Dn As Range
   Dim Ary As Variant, r As Long, i As Long
   Set Rng = Range("D2:D35525") 'Range to match against
   
   
   With CreateObject("scripting.dictionary")
      .CompareMode = vbTextCompare
      
      For Each Dn In Rng: .Item(Dn.Value) = Empty: Next
      
      For i = 6 To 3282
         Ary = Range(Cells(2, i), Cells(62601, i)).Value2 ' Range to clear
         
         For r = 1 To UBound(Ary)
            If Not .exists(Ary(r, 1)) Then Ary(r, 1) = ""
         Next r
         Range(Cells(2, i), Cells(62601, i)).ClearContents
         Range(Cells(2, i), Cells(62601, i)).Value = Ary
      Next i
   End With
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
   Application.DisplayStatusBar = True
   Application.EnableEvents = True
End Sub

But with that amount of data it's still going to take some time & may well crash

 

[Tardisgx]

Ok Thanks i'll leave it overnight and let you know.

 

[Fluff]

OK.

 

[Tardisgx]

I'm sorry your above attempt did not solve my issue it crashed regardless of the time involved it; this would be a really would be a useful thing to have; this post was over a week ago; unsolved so does that mean if it's unsolved the first time; it's unsolvable by the forum.

 

[Fluff]

It's not necessarily unsolvable, but with over 205 million cells it may be a problem.
Try

Sub REMOVEPIDS()
   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False
   Application.DisplayStatusBar = False
   Application.EnableEvents = False

   
   Dim Rng As Range, Dn As Range
   Dim Ary As Variant, r As Long, c As Long, i As Long, j As Long
   Set Rng = Range("A2:A35524") 'Range to match against
   
   
   With CreateObject("scripting.dictionary")
      .CompareMode = vbTextCompare
      
      For Each Dn In Rng: .Item(Dn.Value) = Empty: Next
      
      For i = 3 To 3279 Step 1000
         j = IIf(i < 3002, 999, 276)
         Ary = Range(Cells(1, i), Cells(62600, i + j)).Value2 ' Range to clear
         
         For r = 1 To UBound(Ary)
            For c = 1 To UBound(Ary, 2)
               If Not .exists(Ary(r, c)) Then Ary(r, c) = ""
            Next c
         Next r
         Range(Cells(2, i), Cells(62601, i + j)).ClearContents
         Range(Cells(2, i), Cells(62601, i + j)).Value = Ary
      Next i
   End With
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
   Application.DisplayStatusBar = True
   Application.EnableEvents = True
End Sub

This limits the read/write to the sheet, which may help

 

[Tardisgx]

Hi thanks for keeping interest the moment I have a strange issue; please read to the end.


Ok thanks i've left this running on my home computer which is an OC i7-4790k not frozen but still running- not hopeful. I've had an idea though.

https://imgur.com/a/usunRgo These cells are there as a result of text-columns I have since ordered the data by delimiter number and then done text to columns so my worksheet is essentially like this.

https://imgur.com/a/KOIH2tK With the master list A1:A35524 The first column to search is C1:C62600 and the last is DVC1:DVC7 If the range to search were a column loop; C1 control shift down;search;D1 repeat at the moment I have a strange issue.

I tired inserting select special constants vba code into my original macro instead of the actual range Set Rng = Range("F2:DVF62601") ' Range to clear and it ran and finished!

Except it deleted everything! so I reduced the search area to 1 column [all deleted] and then 20 cells in that 1 column [all deleted] and realised matches were being ignored and cleared unless I physically clicked into a cell and pressed enter. [1match survived the clear onslaught] so there is something wrong with the cells formatting? I've tried copying its formatting to the other cells; pasting the cells in and out of the sheet. I don't know what's going on.

https://drive.google.com/open?id=1BG-u0wHJU5Nxm-L-oV41JV0vf9ja54LN Here is a small portion of my file (just column C to search) master list in in A. 2 cells survive the macro; 2 cells ive clicked and entered on. Any idea? The macro is sound the cells are somehow messed up

 

[Fluff]

The problem is that col A is text, whereas the rest of the cells are numbers.
This resolves that for your test file

Sub REMOVEPIDS()
   Application.Calculation = xlCalculationManual
   Application.ScreenUpdating = False
   Application.DisplayStatusBar = False
   Application.EnableEvents = False

   
   Dim Rng As Range, Dn As Variant
   Dim Ary As Variant, r As Long, c As Long, i As Long, j As Long
   Ary = Application.Transpose(Range("A2:A35524").Value2) 'Range to match against
   
   
   With CreateObject("scripting.dictionary")
      .CompareMode = vbTextCompare
      
      For Each Dn In Ary: .Item(CDbl(Dn)) = Empty: Next
      
'      For i = 3 To 3 '3279 Step 1000
'         j = IIf(i < 3002, 999, 276)
         Ary = Range(Cells(1, 3), Cells(62600, 3)).Value2 ' Range to clear
         
         For r = 1 To UBound(Ary)
'            For c = 1 To UBound(Ary, 2)
               If Not .exists(Ary(r, 1)) Then Ary(r, 1) = Empty
'            Next c
         Next r
         Range(Cells(2, 3), Cells(62601, 3)).ClearContents
         Range(Cells(2, 3), Cells(62601, 3)).Value = Ary
'      Next i
   End With
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
   Application.DisplayStatusBar = True
   Application.EnableEvents = True
End Sub