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.
Code:
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
Bookmarks