Search and remove values ​​from a list

[PcMax]

Hi,

I have a list of values ​​to be removed more adjacent columns
I produced the following code and I hoped would be faster in execution.

Option Explicit

Sub PositionNumbers()
'Disable these commands
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim area As Range
Set area = Range("T7:CG7") 'Range to be analyzed
Dim Col As Variant, Colonna As Integer
Dim NewList As Variant, EscList() As Variant
Dim X As Variant
Dim CicloA As Long, CicloB As Long
EscList = Range("R8:R" & Range("R" & Rows.Count).End(xlUp).Row) 'Range with values to delete

For Each Col In area
Colonna = Col.Column
NewList = Range(Cells(8, Colonna), Cells(Cells(Rows.Count, Colonna).End(xlUp).Row, Colonna))
For CicloA = 1 To UBound(NewList)
X = NewList(CicloA, 1)
For CicloB = 1 To UBound(EscList)
If EscList(CicloB, 1) = X Then NewList(CicloA, 1) = "": Exit For
Next CicloB
Next CicloA
Cells(8, Col.Column).Resize(UBound(NewList, 1)) = NewList
Next Col

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = False
Application.ScreenUpdating = True
End Sub

Wonder if there are better performing codes

thank you in advance

[Rick Rothstein]

I do not know if this is faster than your code or not (you will have to test it to see), but it involves a whole lot less looping...

Sub PositionNumbers()
Dim N As Long, LastRow As Long, ListToDelete As Variant
ListToDelete = Range("R8:R" & Cells(Rows.Count, "R").End(xlUp).Row)
LastRow = Columns("T:CG").Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Application.ScreenUpdating = False
For N = 1 To UBound(ListToDelete)
Range("T8:CG" & LastRow).Replace ListToDelete(N, 1), "", xlPart
Next
Application.ScreenUpdating = True
End Sub

[Rick Rothstein]

I do not know if this is faster than your code or not (you will have to test it to see), but it involves a whole lot less looping...

Sub PositionNumbers()
Dim N As Long, LastRow As Long, ListToDelete As Variant
ListToDelete = Range("R8:R" & Cells(Rows.Count, "R").End(xlUp).Row)
LastRow = Columns("T:CG").Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row
Application.ScreenUpdating = False
For N = 1 To UBound(ListToDelete)
Range("T8:CG" & LastRow).Replace ListToDelete(N, 1), "", xlPart
Next
Application.ScreenUpdating = True
End Sub

I see you have been online at least 3 times since I posted the above code... just wondering if you had a chance to try it out yet or not?

[PcMax]

Hi,



I see you have been online at least 3 times since I posted the above code... just wondering if you had a chance to try it out yet or not?

Rick I tried the code and it works perfectly
I tried with little data to analyze, and I always time 0.015 seconds

The database in which it must operate had the following search time ...
I wrote my code to reduce the search time from: 60:00 minutes 6:00 minutes
Insert an update when i can test with a complete database.

Greetings from Gian

[Rick Rothstein]

Rick I tried the code and it works perfectly
I tried with little data to analyze, and I always time 0.015 seconds

The database in which it must operate had the following search time ...
I wrote my code to reduce the search time from: 60:00 minutes 6:00 minutes
Insert an update when i can test with a complete database.

I'll be interested in how it does compared to your existing code. I am guessing that your complete database must be quite large as the approach you took in the code you posted (while I think it could be "tightened up" a small amount) does not look to be inefficient... given that, taking 6 minutes to run would seem to indicate a rather large amount of data being processed.