CASE Else analog for use in Array

[Dr. Demento]

I'm adapting a data validation sub that utilizes Ranges instead to use an Array. Already, the time savings are substantial, but I'm hung up on one last aspect.

Below is one of the original functions I used. The code before the CASE statement I've handled and the first part of the CASE statement has been replaced with a Find/Replace function for the array (thanks, shg); however, I'm stuck at the CASE ELSE.

Function fx_SEX(ByRef ths As Worksheet, _
                ByRef gnrCol As range)
Dim cell As range  For Each cell In gnrCol
    If IsError(cell.value) = True Then
      format_ErrorLog ths, cell, "err" ', gbl_tblLog_fmt
    ElseIf cell = vbNullString Or cell.Value2 = "NULL" Then
      cell = vbNullString
      If Not cell.MergeCells Then _
        format_ErrorLog ths, cell, "null" ', gbl_tblLog_fmt
    Else
      Select Case cell.value
        Case "M", "Male":           cell.Value2 = "M"
        Case "F", "Female":         cell.Value2 = "F"
        Case "U", "UNK", "Unknown": cell.Value2 = "U"
        [COLOR=#ff0000][B]Case Else[/B][/COLOR]
          format_ErrorLog ths, cell, "err" 
      End Select
    End If
  Next cell
  
End Function

Below is shg's Find/Replace function, using an array (rra_FindReplace) based off of a table with Find and Replace terms in each of the columns

 Sub arr_replace(rra_data As Variant, _
                 icol As Long, _
                 rra_FindReplace As Variant, _
                 ths As Worksheet)
' ~~ Find/Replace All equivalent for arrays
' [URL]http://www.mrexcel.com/forum/excel-questions/983164-replace-all-equivalent-arrays.html#3[/URL]
Dim irow_FR As Long, _
    irow_arr As Long
    
  For irow_FR = LBound(rra_FindReplace) To UBound(rra_FindReplace)
    For irow_arr = LBound(rra_data, 1) To UBound(rra_data, 1)
      If UCase(rra_data(irow_arr, icol)) = UCase(rra_FindReplace(irow_FR, 1)) Then
        rra_data(irow_arr, icol) = rra_FindReplace(irow_FR, 2)
      End If
    Next irow_arr
  Next irow_FR
End Sub

My questions are these: 1) using the the terms in rra_FindReplace(irow_FR, 2) {the Replace portion of the table}, how can I identify any remaining elements that don't fit the replacement terms (ie, the CASE ELSE of the original function)? The downside of using the original Find/Replace array is that the second column contains duplicate data (three values for U).
2) how can I use the original F/R table instead of creating a new table without duplcates for the Collection (if a Collection is the way to go)??

I've created a 1D array without duplicates of the Replace terms, created a collection, and then used MATCH/INDEX, but all that gets me is an error one cell below the end of the table/used range within the Sex column (duplicated three times, as that's the number in terms in the Collection), and ignores all other real errors. Here's what I've kludged together so far.

  ' ~~ Convert" the array to a collection (unique list of Replace items)
  For i = 1 To UBound(arr_coll, 1)
    On Error Resume Next
    coll.Add arr_coll(i, 1), CStr(arr_coll(i, 1))
  Next i
  
  ' [URL="http://stackoverflow.com/a/7740341"]Excel vba - Compare two ranges and find non matches - Stack Overflow[/URL]
  For i = 1 To coll.count
    If Application.WorksheetFunction.Match(coll(i), Application.WorksheetFunction.index(rra_data(), 0, icol), 0) = "#N/A" Then _ ' [COLOR=#0000ff][B]<-- I just need the IF statement to evaluate properly![/B][/COLOR]
      format_ErrorLog ths, ths.Cells(irow, icol), "err"  '<-- this is just "do something" and works fine as is
  Next i

Most importantly, I need to avoid those cases where the sub labels "F" as being wrong when it's evaluating the "M" term. I was hoping to roll the solution into the Find/Replace function above.

Any help would be most appreciative. Thanks y'all

 

[Jerry Sullivan]

I think it's better not to assume that that the values passed to a function in an array were from the first non-blank cell in a sheet. It's more robust just to pass the top left cell of the range that was the source of the array to the function.

With that, you can get the corresponding cell for any element of the array with simply:

rTopLeft(lRow, lCol)

Here's an example function and calling Sub loosely based on your OP. Populate cells in B4:J11 of the active sheet with random values. Then place the find expression "Male" in some of those cells. The code below will replace each instance of "Male" with "M" and change the color of all cells that didn't have the value "Male" to red.

Sub TestCall()
 Dim rData As Range, rNonMatches As Range
 Dim arr As Variant
 
 Set rData = Range("B4:J11")
 
 arr = rData.Value
 
 Set rNonMatches = rFindReplaceAndReturnNonMatchingCells( _
   rTopLeft:=rData(1), vArr:=arr, _
   sFind:="Male", sReplaceWith:="M")

 '--write cells back to range after replacements made
 rData.Value = arr
 
 '--change color of cells that didn't match sFind.
 If Not rNonMatches Is Nothing Then
   rNonMatches.Interior.Color = vbRed
 End If
   
End Sub

Function rFindReplaceAndReturnNonMatchingCells( _
   ByVal rTopLeft As Range, _
   ByRef vArr As Variant, ByVal sFind As String, _
   ByVal sReplaceWith As String) As Range

 Dim lRow As Long, lCol As Long
 Dim rReturn As Range

 For lRow = LBound(vArr, 1) To UBound(vArr, 1)
   For lCol = LBound(vArr, 2) To UBound(vArr, 2)
      If vArr(lRow, lCol) = sFind Then
         '--replace value in array
         vArr(lRow, lCol) = sReplaceWith
      Else
         '--add to return range of non matching cells
         If rReturn Is Nothing Then
            Set rReturn = rTopLeft(lRow, lCol)
         Else
            Set rReturn = Union(rReturn, rTopLeft(lRow, lCol))
         End If
      End If
   Next lCol
 Next lRow
 Set rFindReplaceAndReturnNonMatchingCells = rReturn
End Function

 

[Dr. Demento]

Apologies and a HUGE Thank You!! I've been pre-occupied with life but I didn't want you to think I was ungrateful for your efforts.

When I have a breather, I will explore your code more fully. If I have any questions, I'll put up another posting.

Thanks again!!