Dazzawm
Well-known Member
- Joined
- Jan 24, 2011
- Messages
- 3,748
- Office Version
- 365
- Platform
- Windows
I have the macro below that I have a list on sheet 2 and I enter the column the data will be in on sheet 1 in an input box and it highlights where they are found. I used on 2010 and worked instantly, since I upgraded to 365 it hangs and sometimes doesn't complete. Can or does anything need changing for 365 please? On this occasion I had to stop it and debug and pointed to On Error Resume Next
Code:
Sub ColumnASheet2AnyColumnSheet1()
Dim x As Long, Cols As Variant, Numbers As Variant, n As Variant
Application.ScreenUpdating = False
Sheets("Sheet1").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Cols = Application.InputBox(prompt:="Please input columns i.e:- AB,AF,AM:AQ", Type:=2)
If Cols = "" Or Cols = "False" Then Exit Sub
Cols = Split(Cols, ",")
For x = 0 To UBound(Cols)
If InStr(Cols(x), ":") = 0 Then Cols(x) = Cols(x) & ":" & Cols(x)
Columns(Cols(x)).TextToColumns
Columns(Cols(x)).NumberFormat = "0"
Next
Cols = Join(Cols, ",")
With Worksheets("Sheet2")
Numbers = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row)
End With
Cells.Interior.ColorIndex = xlColorIndexNone
For Each n In Numbers
If Len(n) Then
With Worksheets("Sheet1").Range(Cols)
.Replace "*" & n & "*", "#N/A", xlWhole
On Error Resume Next
.SpecialCells(xlConstants, xlErrors).EntireRow.Interior.ColorIndex = 6
On Error GoTo 0
.Replace "#N/A", n, xlWhole
End With
End If
Next
Cells.Select
Sheets("Sheet1").Activate
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add(Range("C2:C611582"), _
xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255, _
255, 0)
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range( _
"A2:A611582"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:AZ611582")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.Goto Range("A1"), True
Application.ScreenUpdating = True
End Sub