Find the Missing Alpha-Numerics

[rjb1]

I have large spreadsheet with one column having alpha-numeric entries:

AZ0011
M0004
R003
AZ01
M01
R1
...and so on

I need to take the column, probably to another sheet, and with a macro, sort it by the alpha part and the numeric part and then see what sequential numbers are missing.

Result:
AZ01
AZ0002
AZ003
AZ0004
Missing AZ05 <-- these could be hi-lited
Missing AZ06
AZ007
M01
Missing M002
Missing M003
M0004
R01
Missing R002
R003

Any help offered would be appreciated!

 

[KenWright]

There's no consistency in your data. If AZ05 and AZ06 are missing then why are AZ03, AZ03 etc not also missing. You cannot claim that AZ0002 is the same as AZ02, or AZ003 is the same as AZ03 etc because it isn't. Do you have a set of criteria that specify the limits for each data type, eg AZ 1-9 regardless of 0s or something like that.

 

[rjb1]

I guess that is the point. In this spreadsheet, AZ02 is the same as AZ2, which is the same as AZ00000002. (There should only be one 2)

If everything was the same format then sort would work.

The number of zeros is not constant and could be stripped out.

Any macro would have to parse the contents looking for the alpha and numeric parts and ignore the zeros.

If possible, the macro could indicate duplicates.

ie
AZ2
AZ02 <---Duplicate
AZ00000002 <---Duplicate

 

[PA HS Teacher]

Here are two user defined functions I made up. The first extract all numbers from a text string, and the second extracts all nonnumeric characters from a text string.

Function NumberPart(Num As String) As Integer
Dim i As Integer, C As Integer, NumberText As String
NumberText = ""
For i = Len(Num) To 1 Step -1
C = Asc(Mid(Num, i, 1))          ' ASCII Number Corresponding to this Character
  If C< 47 Or C > 57 Then
                                   'Don't includ this character in Phone Number
  Else
    NumberText = Chr(C) & NumberText
  End If
Next i
NumberPart = NumberText
End Function

Function StringPart(Num As String) As String
Dim i As Integer, C As Integer
StringPart = ""
For i = Len(Num) To 1 Step -1
C = Asc(Mid(Num, i, 1))          ' ASCII Number Corresponding to this Character
  If C< 48 Or C > 57 Then
     StringPart = Chr(C) & StringPart
  Else
      'Don't include this character
  End If
Next i
End Function

Example of use:

Book1
	F	G	H	I
2	Entry	NumberPart	StringPart
3	AZ0011	11	AZ
4	M00040	40	M
5	R003	3	R
6	AZ01	1	AZ
7	M01	1	M
8	R1	1	R
Age Groups

You can then use Excel's built in autofilter and sort capabilities to look for missing entries. You perhaps sort the data by String part, then numeric part. If you have lots of entries you could then use conditional formatting to quickly find gaps between entries. Post back if you have questions.

 

[erik.van.geit]

Just another approach.

You could "format" the cells by code.
In fact it's not formatting but really adding zeros.
Choose the total number of numerics. (now setup at 8)

R3 or R03 or R003 or R000003
will all end up as
R00000003

kind regards,
Erik

(EDIT: assuming data are in column A)

Sub format_alphanumerics()
'Erik Van Geit
'050130
Dim rng As Range
Dim cell As Range
Dim i As Integer
Dim totnum As Integer

totnum = 8 '(total of numerics in your cells: leading zeros will be inserted)
Set rng = Range(Cells(1, 1), Cells(65536, 1).End(xlUp))
rng.Select
For Each cell In rng
cell = Trim(cell)
  For i = 1 To Len(cell)
    If IsNumeric(Mid(cell, i, 1)) Then
    cell = Left(cell, i - 1) & Application.WorksheetFunction.Rept("0", totnum - 1 - Len(cell) + i) & Right(cell, Len(cell) - i + 1)
    Exit For
    End If
  Next i
Next cell
End Sub

 

[brettdj]

Hi,

I see that the alpha part of your string has a "max" value of AZ. So a shortcut way of dumping the data would be to use Excel's row and columns as a map

AZ0011 = Cell AZ11
M0004 = Cell M4
R003
AZ01
M01
R1

My code below uses a regular expression to parse the string into a column and row, and it then uses a dictionary object to check for a duplicate. If the data is a dup then the cell ref is coloured red, if not then the value is dumped to its appropraite position in a new sheet which lets you see the gaps

I've assumed that your data is in column A, If not then change
Set Myrange = Range(Range("a1"), Range("A65536").End(xlUp))
to
Set Myrange = Range(Range("XX1"), Range("XX65536").End(xlUp))
where XX is your column

If your alpha exceeds IV then I will modify the code to use the columns from A to IV as headings for each discrete alpha (ie Column A = AZ values, B = M, C is R etc), please let me knoe if this is the case

Cheers

Dave

Sub ExtractPart()

    Dim Myrange As Range, C As Range
    Dim RegEx As Object, MyDict As Object
    Dim ws As Worksheet
    Dim NumString As Long, AlphaString As String

    Set Myrange = Range(Range("a1"), Range("A65536").End(xlUp))
    Set RegEx = CreateObject("vbscript.regexp")
    Set MyDict = CreateObject("scripting.dictionary")
    Set ws = Worksheets.Add

    RegEx.Pattern = "([A-Z]+)(\d+)"
    For Each C In Myrange
        If RegEx.test(C.Value) = True Then
           AlphaString = Trim(RegEx.Replace(C.Value, "$1"))
           NumString = Val(RegEx.Replace(C.Value, "$2"))
            'make dupes red
            If MyDict.exists(AlphaString & NumString) Then
                ws.Cells(NumString, AlphaString).Interior.Color = vbRed
            Else
                'dump string to appropriate row and column position
                ws.Cells(NumString, AlphaString) = C.Value
                MyDict.Add AlphaString & NumString, 1
            End If
        End If
    Next
    
    Set MyDict = Nothing
    Set RegEx = Nothing
End Sub