Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$1" Then
Application.ScreenUpdating = False
Application.EnableEvents = False
With ActiveSheet
If Not Target.Font.Bold Then
MyStr = Empty
y = 2
Do
F6N = True
For x = 1 To 6
N6 = Asc(Mid(.Cells(y, 1), x, 1))
If N6 < 48 Or N6 > 57 Then F6N = False
Next x
If F6N Then
If MyStr <> Empty Then MyStr = MyStr & ","
MyStr = MyStr & .Cells(y, 1)
End If
y = y + 1
Loop Until .Cells(y, 1) = Empty
ary = Split(MyStr, ",")
If .FilterMode Then .ShowAllData
.Range("A:A").AutoFilter
.Range("A:A").AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
Else
.Range("A:A").AutoFilter Field:=1
End If
Target.Font.Bold = Not Target.Font.Bold
.Range("B1").Select
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
Private Sub A_F6N()
Application.ScreenUpdating = False
Application.EnableEvents = False
With ActiveSheet
If Not .Range("A1").Font.Bold Then
MyStr = Empty
y = 2
Do
F6N = True
For x = 1 To 6
N6 = Asc(Mid(.Cells(y, 1), x, 1))
If N6 < 48 Or N6 > 57 Then F6N = False
Next x
If F6N Then
If MyStr <> Empty Then MyStr = MyStr & ","
MyStr = MyStr & .Cells(y, 1)
End If
y = y + 1
Loop Until .Cells(y, 1) = Empty
ary = Split(MyStr, ",")
If .FilterMode Then .ShowAllData
.Range("A:A").AutoFilter
.Range("A:A").AutoFilter Field:=1, Criteria1:=(ary), Operator:=xlFilterValues
Else
.Range("A:A").AutoFilter Field:=1
End If
.Range("A1").Font.Bold = Not .Range("A1").Font.Bold
.Range("B1").Select
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub