Public Sub GPE()
Dim Arr, dArr, I As Long, K As Long, J As Long, Dk As String
With Sheet1
Arr = .Range("B6", .Range("B65000").End(3)).Resize(, 45).Value
End With
ReDim dArr(1 To UBound(Arr), 1 To 48)
Dk = Range("H2").Value
For I = 1 To UBound(Arr)
If Arr(I, 16) Like Dk Or Arr(I, 19) Like Dk Or Arr(I, 22) Like Dk Or _
Arr(I, 25) Like Dk Or Arr(I, 28) Like Dk Or Arr(I, 31) Like Dk Then
K = K + 1
dArr(K, 1) = K
For J = 1 To 45
dArr(K, J + 1) = Arr(I, J)
Next J
If Len(Arr(I, 3)) <= 3 Then
dArr(K, 47) = Val(Left(Arr(I, 3), Len(Arr(I, 3)) - 1))
dArr(K, 48) = Right(Arr(I, 3), 1)
Else
dArr(K, 47) = Arr(I, 3)
End If
End If
Next I
If K Then
Range("A6").Resize(K, 48).Value = dArr
Range("B6").Resize(K, 47).Sort Range("AU6"), xlAscending, Range("AV6"), , xlAscending
Range("AU6").Resize(K, 2).ClearContents
End If
End Sub
