Excel VBA deleting rows that have mixed values for a given index

Question

I have the following data

Name     ID    Value

Alice    12C    500

Bob      14     60

Dan       15C    64

Dan       1C    25

Alice    4       556

Bob      11     455

In my data, Alice has both numerical (4) and string+numerical ID (12C) and I want to delete all Alice rows, while I want to hold on to data of names where their ID is strictly numeric (Bob 11, 14) or strictly string+numeric (Dan 15C , 1C).

First I make an array of unique Name entries:

   FinalRow = 7
   Name_column = 1
   n = 1

     Dim FID_Array() As Variant

          ReDim Preserve FID_Array(1 To 1)
          FID_Array(1) = Cells(2, Name_column)

     For j = 3 To FinalRow

        If Cells(j, Name_column).Value <> FID_Array(n) Then
                 ReDim Preserve FID_Array(1 To n + 1)
                 FID_Array(n + 1) = Cells(j, Name_column).Value
                 n = n + 1


        End If
     Next j

Then I make an Array of the row numbers that contain a particular Name

ReDim Preserve Count_FID_Array(1 To 1) As Variant
  n = 1
  range_FID = A2:A7


' In my actual code this is Range_FID
' range_FID = Cells(2, FolderId_column).Address & ":" & Cells(FinalRow,  FolderId_column).Address

   For Each itm5 In FID_Array()

           Count_FID_Array(n) = Application.CountIf(" & range_FID & ", " & itm5 & ")
           ReDim Preserve Count_FID_Array(1 To n + 1)
           n = n + 1

    Next itm5

I don't think my CountIf is working. I have tried to store the value of Count_FID_Array in another cell in a different sheet but I am getting #value!

If I got the countIf to work then I was going to sort the data by name, then double loop to check the ID variable the next "n" times to see if the last digit was "C" for all of them or to check if the ID was numeric for all of them.

Can you please point out why my countif is not working and is there a smarter way to do this?

I am using arrays of names here because in the end I want to feed the array into an autofilter and delete the rows that I don't want.

Update 1 3:45 PM Nov 21 2013: I have solved this as following:

I basically created three columns. First column was 0 or 1 depending on if the the ID was all numbers. The second column was 0 or 1 depending on if the last digit was "C" (in my real work the last two digits are "IB" ) and finally I compared the frequency of these occurences to the frequency of the Name itself. If any of those match then I give it the number 1 else 0. I use this index later to autofilter.

Now I'll try to use zx8754's shorter formula in the VBA code and I will try to address the issues regarding Countif that Joe has raised.

Sub conditionsforsubfolders()

  FinalColumn = Cells(1, Columns.Count).End(xlToLeft).Column
  FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
  ActiveWorkbook.ActiveSheet.Columns(FinalColumn + 1).Insert
  ActiveWorkbook.ActiveSheet.Columns(FinalColumn + 2).Insert
  ActiveWorkbook.ActiveSheet.Columns(FinalColumn + 3).Insert

  Isnumber_Column = FinalColumn + 1
  Is_IB_Column = FinalColumn + 2
  Exceptions_Column = FinalColumn + 3
  Cells(1, Isnumber_Column) = "Number"
  Cells(1, Is_IB_Column) = "Letters"
  Cells(1, Exceptions_Column) = "Exceptions"

  For j = 1 To FinalColumn
     If Cells(1, j).Value = "TradeId" Then
         TradeId_column = j
     ElseIf Cells(1, j).Value = "Total Notional per folder" Then
         Total_Notional_Per_Folder_Column = j
     ElseIf Cells(1, j).Value = "ExternalId" Then
         ExternalId_Column = j
      ElseIf Cells(1, j).Value = "FolderId" Then
         FolderId_column = j

     End If
   Next j
   range_FolderId_fixed = Cells(2, FolderId_column).Address & ":" & Cells(FinalRow, FolderId_column).Address
   range_TradeId_fixed = Cells(2, TradeId_column).Address & ":" & Cells(FinalRow, TradeId_column).Address
   range_Isnumber = Cells(2, Isnumber_Column).Address & ":" & Cells(FinalRow, Isnumber_Column).Address(RowAbsolute:=False, ColumnAbsolute:=False)
   range_Isnumber_fixed = Cells(2, Isnumber_Column).Address & ":" & Cells(FinalRow, Isnumber_Column).Address
   range_Is_IB = Cells(2, Is_IB_Column).Address & ":" & Cells(FinalRow, Is_IB_Column).Address(RowAbsolute:=False, ColumnAbsolute:=False)
   range_Is_IB_fixed = Cells(2, Is_IB_Column).Address & ":" & Cells(FinalRow, Is_IB_Column).Address(RowAbsolute:=False, ColumnAbsolute:=False)
   range_FolderId_cell = Cells(2, FolderId_column).Address(RowAbsolute:=False, ColumnAbsolute:=False)
   range_TradeId_cell = Cells(2, TradeId_column).Address(RowAbsolute:=False, ColumnAbsolute:=False)
   range_Exceptions = Cells(2, Exceptions_Column).Address & ":" & Cells(FinalRow, Exceptions_Column).Address(RowAbsolute:=False, ColumnAbsolute:=False)


   Range(range_Isnumber).Formula = "=Isnumber(" & range_TradeId_cell & ")*1"
   Range(range_Is_IB).Formula = "=(RIGHT(" & range_TradeId_cell & ",2)= ""IB"")*1"

   Range(range_Exceptions).Formula = "=(SUMIF(" & range_FolderId_fixed & "," & range_FolderId_cell & "," & range_Isnumber_fixed & ")= COUNTIF(" & range_FolderId_fixed & "," & range_FolderId_cell & "))*1 +(SUMIF(" & range_FolderId_fixed & "," & range_FolderId_cell & "," & range_Is_IB_fixed & ")= COUNTIF(" & range_FolderId_fixed & "," & range_FolderId_cell & "))*1  "
  Worksheets("Sheet1").UsedRange.AutoFilter Field:=7, Criteria1:="=1"

End Sub

Answer 1

Formula solution, no VBA:

=IF(SUMPRODUCT(--($A$2:$A$7=A2),--(ISNUMBER($B$2:$B$7)))=1,"delete","keep")

Answer 2

The problem with your CountIF call is that you're passing a poorly-formed string. You're literally passing " range_FID & ", " & itm5 ".

First, you set to properly define range_fid:

Dim range_fid As Range
Set range_fid = [A2:A7]

The call CountIF with:

count_fid_array(n) = Application.WorksheetFunction.CountIf(range_fid, itm5)

With that said, I would go about it differently:

Dim c As Range
Dim people As Collection: Set people = New Collection
Dim person As Collection
Dim code As String

For Each c In Range(Range("a2"), Range("a2").End(xlDown)) ' loop through all rows
    If IsNumeric(c.Offset(0, 1)) Then ' check if the ID is numeric or not
        code = "num"
    Else
        code = "alphanum"
    End If

    On Error Resume Next  ' Needed in order to avoid error when person already exists in collection
    Set person = New Collection
    person.Add c.Value, "name"
    person.Add code, "code"
    people.Add person, c.Value ' will only be added if name doesn't already exist in collection
    On Error GoTo 0
    If people(c.Value)("code") <> code Then  ' if the format (alpha/num) of the ID on the current row is different than the format of a previous row for this name....
        people(c.Value).Remove ("code")  ' then set the code to "diff"
        people(c.Value).Add "diff", "Code"
    End If
Next

For Each person In people ' just display the content; you can take appropriate action here
    Debug.Print person("name") & ": " & person("code")
Next

The result is a Collection containing names and a code for each. The code will be one of:

• num : all values for a name are numeric (Bob)
• alphanum : all values for a name are alphanumeric (Dan)
• diff : name has at least one each of numeric and alphanumeric (Alice)

Note that this could be done a little clearer with a Dictionary instead of a Collection, or with a Class, but I chose to take the most straightforward approach.