I'm running a sub that goes through the cells on a spreadsheet, extracts numbers 16 digits long (credit cards) and then put them into a tally counting how many times each number occurs. This works very well but I'm suffering the 16 digit problem. Inputting the numbers is fine, I format the cells as texts only but when it outputs them the other end it changes them to the exponential format. How can I force it to keep the text as text and not turn it into a number?
[VBA]Sub vehiclecruncherfree()
'makes sure the right sheet is the active sheet
Set Tally = CreateObject("Scripting.Dictionary")
For Each cll In Intersect(ActiveSheet.UsedRange, Columns(1))
x = Split(cll.Value, " ")
For Each word In x
If ContainsLettersAndNumbers(word) Then
If Tally.exists(word) Then
Tally(word) = Tally(word) + 1
Else
Tally.Add word, 1
End If
End If
Next word
Next cll
myCount = Tally.Count
Set NewWs = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))
NewWs.Range("A1").Resize(myCount) = Application.Transpose(Tally.keys)
NewWs.Range("B1").Resize(myCount) = Application.Transpose(Tally.Items)
NewWs.UsedRange.Sort Key1:=Range("B1"), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
NewWs.Rows(1).Insert
Range("A1:B1") = Array("Number", "Count")
msg = "Results:" & vbLf
For i = 2 To Application.Min(myCount, 10) + 1 ' the 10 here is for the top 10
zz = NewWs.Cells(i, 2)
msg = msg & vbLf & NewWs.Cells(i, 1) & " occurs " & IIf(NewWs.Cells(i, 2) < 3, Choose(NewWs.Cells(i, 2), "once", "twice"), NewWs.Cells(i, 2) & " times")
Next i
MsgBox "Let's look at links, here's your top ten!" & vbLf & msg
End Sub[/VBA]
The code is almost identical to the above except, it limits the words to 16 digits and contains numbers only.