'The following removes blank lines. Blank = no data in any cells
'Works from the bottom to avoid deletion of valid data and conflicts
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For i = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
Selection.Rows(i).EntireRow.Delete
End If
Next i
.Calculation = xlCalculationAutomatic
End With
i = 0
x = lastRow
For x = lastRow To 3 Step -2
Analyzed.Rows(x).Select
Selection.Delete Shift:=xlUp
Next x
DataRows = DataRows + 1
Rw = 1
For Rw = 1 To DataRows Step 1
CelLen = Len(Trim(Analyzed.Cells(Rw, "B")))
Select Case CelLen
Case 7 'Cell contains "Unknown"
Analyzed.Cells(Rw, "C") = Analyzed.Cells(Rw, "B")
Case 4 '4 digit internal dialing
Analyzed.Cells(Rw, "C") = 919
Analyzed.Cells(Rw, "D") = "4 Digits"
Case 3 'Cell contain only area code, number is unknown
Analyzed.Cells(Rw, "C") = Analyzed.Cells(Rw, "B").Value
Analyzed.Cells(Rw, "D") = "Unknown"
Case 12 'US/Canada Call
Analyzed.Cells(Rw, "C") = Mid(Analyzed.Cells(Rw, "B"), 3, 3)
Analyzed.Cells(Rw, "D") = "US/Canada"
Case 10 'US/Canda Call, 81 was not reported
Analyzed.Cells(Rw, "C") = Mid(Analyzed.Cells(Rw, "B"), 1, 3)
Analyzed.Cells(Rw, "D") = "US/Canada"
Case Is > 12 'International Call
Analyzed.Cells(Rw, "C") = Mid(Analyzed.Cells(Rw, "B"), 2, 3)
Analyzed.Cells(Rw, "D") = "International"
Case Else
Analyzed.Cells(Rw, "C") = "Unknown"
End Select
Next Rw
Analyzed.Columns("B:B").EntireColumn.AutoFit
Analyzed.Columns("C:C").EntireColumn.AutoFit
Analyzed.Columns("D:D").EntireColumn.AutoFit
Analyzed.Columns("A:D").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("D1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
DataOption2:=xlSortNormal
Analyzed.Range("A1").Select
GCount = 1
For i = 1 To DataRows Step 1
If (i = 1) Then
Analyzed.Cells(GCount, "G") = 1
Else
If Analyzed.Cells(i, "C") <> Analyzed.Cells(i - 1, "C") Then
Analyzed.Cells(GCount, "G") = 1
End If
End If
If Analyzed.Cells(i, "C") = Analyzed.Cells(i + 1, "C") Then
Analyzed.Cells(GCount, "G") = Analyzed.Cells(GCount, "G") + 1
Analyzed.Cells(GCount, "F") = Analyzed.Cells(i, "C")
Else
If (Analyzed.Cells(i, "C") <> Analyzed.Cells(i + 1, "C")) And (Analyzed.Cells(i, "C") <> Analyzed.Cells(i - 1, "C")) Then
Analyzed.Cells(GCount, "G") = 1
Analyzed.Cells(GCount, "F") = Analyzed.Cells(i, "C")
End If
GCount = GCount + 1
End If
Next i
Application.ScreenUpdating = True