Hi all, I work with Excel 365 and I created a macro with the record function, I´ve added some more code and tried to clean it a but and its useful for most cases, its about filtering data, formatting and arranging it, still, there are some instances in which the database I want to apply this to has more than 200,000 rows and the macro gets excel to not respond and freeze, I suppose its because its not optimized / Im using code in not a great way, it would be super helpful if you can hel pe with this. here`s my code:

Sub Duplicate_Documents_Using_Checksum_Value()
'
' Duplicate_Documents_Using_Checksum_Value Macro
'

' Removing screen updates & auto calculation
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

' Delete columns D:E & F:G
Columns("D:E").Select
Selection.Delete Shift:=xlToLeft
Columns("F:G").Select
Selection.Delete Shift:=xlToLeft

' Conditional formatting > Duplicate values
Columns("F:F").Select
Selection.FormatConditions.AddUniqueValues
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).DupeUnique = xlDuplicate
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With

' Filter only duplicates
Selection.FormatConditions(1).StopIfTrue = False
ActiveSheet.Range("$A$1:$F$10675").AutoFilter Field:=6, Criteria1:=RGB(255 _
, 199, 206), Operator:=xlFilterCellColor

' Select All columns > Find and Select > Goto Special > Visible Cells Only > Copy > Paste on new sheet
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.SpecialCells(xlCellTypeVisible).Select
Application.CutCopyMode = False
Selection.Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste

' Delete Sheet0
Application.DisplayAlerts = False 'switching off the alert button
Sheets("Sheet0").Select
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True 'switching on the alert button

' Make Table1
Application.CutCopyMode = False
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A1", Range("d1").End(xlDown).End(xlToRight)), , xlYes).Name = _
"Table1"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("Table1[#Headers]").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With

' Autofit columns
Columns("A:F").Select
Columns("A:F").EntireColumn.AutoFit

' Change Sheet1 name to Study
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Study"

' Clear filters
If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilter.ShowAllData

' Sorting
ActiveWorkbook.Worksheets("Study").ListObjects("Table1").Sort.SortFields.Add2 _
Key:=Range("Table1[Checksum]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Study").ListObjects("Table1").Sort.SortFields.Add2 _
Key:=Range("Table1[Study Country]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Study").ListObjects("Table1").Sort.SortFields.Add2 _
Key:=Range("Table1[Study Site]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Study").ListObjects("Table1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With


' Restoring screen updates & auto calculation
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

' End Message
MsgBox (" Duplicate document search completed! ")
End Sub