trjhtr

The macro below clears cells that do not match any cell in comparison to a range (a master list). It works on small file but is too slow to work for files with large ranges.

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

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

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

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

Set Rng = Range("C1:DVC62600")' Range to clear 
ForEach Dn In Rng
IfNot.exists(Dn.Value)Then Dn.ClearContents

Next Dn

EndWith

EndSub

The worksheet looks like so:

Okay, so good job giving both declared variables a type, a lot of people forget that!

But, your naming is sort of weak and doesn't follow Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

I know it's just a small script, but since you're using it on more than one sheet, apparently, you should make it more robust.

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

You have a With and create an object. Instead perhaps create the object and then use it:

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

It's good practice to indent all of your code that way Labels will stick out as obvious. Right now it's all flat and it's not obvious your first loop has a Next.

So I'll assume you want to stick with a dictionary.

Dim lastRow As Long
lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
Dim dictRange As Range
Set dictRange = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(lastRow, 1))

Dim dict As Object
dict = CreateDictionary(dictRange)

Private Function CreateDictionary(ByVal dictRange As Range) As Object
 Dim dict As Object
 Set dict = CreateObject("Scripting.Dictionary")
 Dim keyRange As Range
 For Each keyRange In dictRange
 dict.Item(keyRange.Value) = 1
 Next
 CreateDictionary = dict
End Function

Here you pass the range you need to a helper function and create the dictionary. Now you want to check if certain cells' values are keys of the dictionary. It's not clear how you determine this because you're using an enormous range, for some reason. Let's assume you just want Column C-

lastRow = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row
Dim i As Long
For i = 1 To lastRow
 If Not dict.exists(Sheet1.Cells(i, 3).Value) Then Sheet1.Range(Sheet1.Cells(i, 3), Sheet1.Cells(i, 200)).Clear
Next

Done, yeah?

So the reason you're hanging is because you're iterating through enormous ranges that are probably mostly blank. You need to be explicit in your ranges. You're also dealing with the data on the sheet, which is slow - Be sure to avoid things like .Select - 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.

You also turn a bunch of stuff off, but don't turn it back on!

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

 Dim lastRow As Long
 lastRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
 Dim dictRange As Range
 Set dictRange = Sheet1.Range(Sheet1.Cells(1, 1), Sheet1.Cells(lastRow, 1))

 Dim dict As Object
 dict = CreateDictionary(dictRange)

 lastRow = Sheet1.Cells(Rows.Count, 3).End(xlUp).Row
 Dim i As Long
 For i = 1 To lastRow
 If Not dict.exists(Sheet1.Cells(i, 3).Value) Then Sheet1.Range(Sheet1.Cells(i, 3), Sheet1.Cells(i, 200)).Clear
 Next

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

Private Function CreateDictionary(ByVal dictRange As Range) As Object
 Dim dict As Object
 Set dict = CreateObject("Scripting.Dictionary")
 Dim keyRange As Range
 For Each keyRange In dictRange
 dict.Item(keyRange.Value) = 1
 Next
 CreateDictionary = dict
End Function