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

 

[Dr. Demento]

bump

 

[Jerry Sullivan]

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).

You can identify the terms that don't match a Find element in the F/R table with an Else statement in your If/Then Block

  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)
[COLOR="#0000FF"][B]      Else
          '--do something with non-matches
          debug.print  rra_data(irow_arr, icol)
 [/B][/COLOR]

      End If
    Next irow_arr
  Next irow_FR

If your question is about how you could map back to the cell that had the non-match, you'd probably pass a reference to the upper left cell that was the source for the variant rra_data, then you use .Offset or other relative reference method to identify the non-matching cell's location.

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)??

Use of a Collection or Dictionary could be beneficial if the F/R table has a large number of rows. The number of rows in rra_data, doesn't affect the relative efficiency of using an Array vs a Collection. (although as a practical matter, if rra_data has very few rows, then having a less efficient lookup might not make a noticeable difference to the user).

I'm not following your comment about a removing duplicates from the F/R table. The F/R table should only have unique items in the Find column and the same would be true of a Dictionary's Keys.

If you want to store your lookup mapping in a 2D range where the 1st Column contains the Replace value and multiple columns are used to store the various associated items, you could do that. Your code could convert that 2D array of values into the same 2-Column Array or Collection. Whether that's beneficial is more of a user interface matter about the maintenance of the table.

 

[Dr. Demento]

Jerry,

Thank you for your reply. I love getting feedback because it helps clarify my thinking.

You can identify the terms that don't match a Find element in the F/R table with an Else statement in your If/Then Block

  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)
[COLOR=#0000ff][B]      Else
          '--do something with non-matches
          debug.print  rra_data(irow_arr, icol)
 [/B][/COLOR]      End If
    Next irow_arr
  Next irow_FR

I have tried as you suggested above, but the problem I run into is that during the loop when rra_FindReplace = "M" and evaluates rra_data = "F", this will be evaluated as erroneous and while this is technically true, it doesn't really work because F is a valid value, just not during that particular loop. That's why I originally liked CASE Else -- if the cell.value didn't match up with any of the five values for SEX (M|Male|F|Female|U|Unk|Unknown), then it identified and logged the error.

Forgive me on this next part; I couldn't find a logical sequence, so I'm jumping back and forth a bit.

I'm not following your comment about a removing duplicates from the F/R table. The F/R table should only have unique items in the Find column and the same would be true of a Dictionary's Keys.

My point with this comment has to do with how I understand how the CASE statement transfers from my original code to my updated method (using arrays for both the data and the find/replace terms).

First, there's a find/replace action; after this is complete, I'm left with two groups of data 1) all the elements that were updated to the Replace elements (M|F|U) and 2) everything else that didn't match with any of the Find elements. The CASE ELSE handles the #2 portion of the data.

After using shg's F/R code in the updated method, I was thinking of using only the Replace elements in an array/collection/dictionary to compare the rra_data all over again. For that, I would need a 1D array of unique elements from the Replace section of my F/R table (re: your comment above). However, there are duplicates in the Replace column - there are three U's (U|Unk|Unknown), two for M & F each, making seven entries for only three values (M|F|U). Upon thinking, I'm sure I can come up with a short function to return a 1D array of unique items from the second column of rra_FindReplace. You can ignore this part of my request. However, if there's any advantages to array/dictionary/collection in this particular context, I'd be happy to understand more.

That is why I was hoping to use something like a MATCH statement (or an ISERROR(MATCH())) to identify those elements that were not in the Replace elements (M|F|U) (effectively creating a CASE Else function). If I'm approaching this in a faulty manner, I'm not opposed to re-tooling my approach but I'm stumped at the moment.

If your question is about how you could map back to the cell that had the non-match, you'd probably pass a reference to the upper left cell that was the source for the variant rra_data, then you use .Offset or other relative reference method to identify the non-matching cell's location.

My thoughts here was since I had imported the entire UsedRange (albeit with better range capture that the native Excel method) and was going to return the processed data to A1, I was going to use .Cells(irow_arr, icol), although I can seen the benefit of using OFFSET should the data be returned to somewhere other than A1.

If you want to store your lookup mapping in a 2D range where the 1st Column contains the Replace value and multiple columns are used to store the various associated items, you could do that. Your code could convert that 2D array of values into the same 2-Column Array or Collection. Whether that's beneficial is more of a user interface matter about the maintenance of the table.

This is exactly what I did; I figured that maintaining a table (especially for others who use my code) would be infinitely easier to understand and maintain than hard-coding the find/replace terms.

All this being said, I realize I could simply rewire my original Function fx_SEX to reference an array instead of a range (and thereby bypass this whole mess of trying to find an alternative to CASE Else) but that would negate my goal of maintaining the F/R terms in a table instead of hard-coding them.

Thank you again for your help.

 

[Dr. Demento]

I think I figured it out. The CASE Else analog would have to be a separate loop, make the Find/Replace as the inner loop, and make the conditional
IF arr_data = arr_FR Then
Exit For
Else
Error logging
End If

I'm on my phone but once I'm able I'll see if it works.

Crap! I just think I saw a flaw in my concept. Grrrr

 

[Jerry Sullivan]

Now I understand your question about the case analog.

One way to do that for the inner loop would be to use a Boolean flag like this.

 bFound = False
 For iRow = LBound(arr_data) To UBound(arr_data)
   If arr_data(iRow) = arr_FR Then
      bFound = True
      'do replace code here
   End If
 Next iRow
 If Not bFound Then
    'error log code here
 End If

I couldn't tell if you had any other unanswered questions in the remainder of your response. Just ask if you want some help with the collection approach.

 

[Dr. Demento]

I take some pride in that I had a similar idea! Yeah! I'm beginning to think like the pros!

One correction; the reset for the bFound needs to inside the outer loop -- otherwise, it never gets reset. (Note to other seekers of truth)

One way to do that for the inner loop would be to use a Boolean flag like this.

 For iRow = LBound(arr_data) To UBound(arr_data)
   [COLOR=#0000ff][B]bFound = False [/B][/COLOR]
  If arr_data(iRow) = arr_FR Then
      bFound = True
      'do replace code here
   End If
 Next iRow
 If Not bFound Then
    'error log code here
 End If

I think my other questions are answered. Thank you so much.

Regarding your offer on the dictionary; I think I'll take you up on it. Instead of creating a dictionary with unique elements from the Replace part of the array, I just looped thru the Replace portion of the array, even with duplicates; seems to work fine.

However, I would like to learn a bit more about how dictionaries work. Below is a function that creates a dictionary of unique elements. If you would explain how the bold/colored line works, that would be awesome. As I understand it, Dictionaries and Collections are just special case arrays -- Dictionaries must have unique keys; Collections can have either duplicate keys (there's some other limitations that I don't understand quite yet). I don't fully understand the potential of them yet but that will come with time, I suppose.

Thank you again, Jerry.

Function Unique(rra As Variant) As Variant
' ~~ Retrieving unique values from a range or array
' [URL]https://newtonexcelbach.wordpress.com/2012/01/31/retrieving-unique-values-from-a-range-or-array/[/URL]
Dim dict As Scripting.Dictionary  '' Early Binding
    Set dict = New Scripting.Dictionary
Dim arr As Variant
Dim i As Long, _
    j As Long, _
    NumRows As Long, _
    NumCols As Long
 
  'Convert range to array and count rows and columns
  If TypeName(rra) = "Range" Then _
    arr = rra.Value2
  NumRows = UBound(arr, 1)
  NumCols = UBound(arr, 2)
 
  'put unique data elements in a dictionay
  'Set dict = CreateObject("Scripting.Dictionary")  ' ~~ late binding
  For i = 1 To NumCols
    For j = 1 To NumRows
      [COLOR=#0000ff][B]dict(arr(j, i)) = 1  <-- Don't understand how this works (= 1 ??)[/B][/COLOR]
    Next j
  Next i
 
'Dict.Keys() is a Variant array of the unique values in rra
 'which can be written directly to the spreadsheet
 'but transpose to a column array first
  If TypeName(rra) = "Range" Then
    Unique = WorksheetFunction.Transpose(dict.Keys)
  Else
    Unique = dict.Keys
  End If
 
End Function

 

[Jerry Sullivan]

I take some pride in that I had a similar idea! Yeah! I'm beginning to think like the pros!

One correction; the reset for the bFound needs to inside the outer loop -- otherwise, it never gets reset. (Note to other seekers of truth)

Hi Dr. Demento,

Your posts always show a desire to learn - which is essential to thinking like a pro.

Regarding the placement of the reset of bFound, you're right that it needs to be inside the outer loop-and that's where it is in my example. Both our snippets only show the inner loop. You've located the reset of bFound inside the inner loop. That will work- but resetting on each inner loops is redundant since the loop will only continue of bFound is False.

However, I would like to learn a bit more about how dictionaries work. Below is a function that creates a dictionary of unique elements. If you would explain how the bold/colored line works, that would be awesome.

...
...

  For i = 1 To NumCols
    For j = 1 To NumRows
[COLOR="#0000CD"] [B]     dict(arr(j, i)) = 1  <-- Don't understand how this works (= 1 ??)[/B][/COLOR]
    Next j
  Next i

To learn more about Dictionaries, I'd suggest you check out SNB's page at this link:
VBA for smarties: Dictionaries

The part of the code that you marked in bold is using an abbreviated form of the method that SNB illustrates in sections:
How to populate: 5.2 method .Item( )=
Add or replace: 6.2.2 method .Item()=

Here's an example that you can experiment with to relate the code you found, with the examples and explanations on SNB's page.

Before running this code, the ActiveSheet should have data in A1:C4 with some duplicates.
The code will populate a Dictionary with the unique values in those cells, then write the list in Column J.

Sub GetUniqueValuesFromRange()
 Dim i As Long, j As Long
 Dim NumCols As Long, NumRows As Long
 Dim arr As Variant
 
 arr = Range("A1:C4").Value
 
 NumRows = UBound(arr, 1)
 NumCols = UBound(arr, 2)
 
 With CreateObject("scripting.dictionary")
   For i = 1 To NumCols
      For j = 1 To NumRows
[B]         .Item(arr(j, i)) = 1[/B]
      Next j
   Next i
   
   Range("J1").Resize(.Count, 1) = Application.Transpose(.keys)

 End With

End Sub

The code assigns the value 1 to each key as it is added. The "1" is just an arbitrary placeholder. The values of the keys are not used in this code, but when the keys are created using this method, there needs to be some value assigned to the key.

 

[Dr. Demento]

. . . inside the outer loop-and that's where it is in my example.

Doh!! All would be better if I paid attention to those pesky details!!

Thank you for snb's references; I will check them out.

Thanks again!

 

[Dr. Demento]

One last question, Jerry.

In your original response to my inquiry you had said

use .Offset or other relative reference method to identify the non-matching cell's location.

I responded that since I was going to put the array back into A1, I said

I was going to use .Cells(irow_arr, icol), although I can seen the benefit of using OFFSET should the data be returned to somewhere other than A1.

However, now that I think about it, I see the wisdom using a relative reference instead of assuming that the user would plunk the data back to A1. In futzing around with some code, I can't make it work though -- how to translate a position inside an array (say (3,2)) to a range where the first cell does not reside at A1. Would you mind taking a look at what I've put together so far and tell me where I'm going wrong??

Public Function rng_Offset(ths As Worksheet, _
                           gnr As range) As range
Dim firstCell As range
  Set firstCell = FirstCellInSheet(ths)
Dim rowOff As Long, _
    colOff As Long
  If firstCell.address = ths.range("A1") Then
    Set rng_Offset = gnr
    Exit Function
  Else
    rowOff = firstCell.Rows(1).row - range("A1").row
    colOff = firstCell.Columns(1).column - range("A1").column
    
    Set rng_Offset = gnr.OffSet(gnr.row - rowOff, gnr.column - colOff)
    Debug.Print rng_Offset.address
  End If
  
End Function

where the FirstCellInSheet function comes from Ejaz Ahmed (here). My goal is to have a generic function that will pair an array element (for convenience's sake, I coded the array element as a range (gnr)) to its actual location on the worksheet given that the first non-empty cell is not A1.

I keep messing around, but I don't know what I'm doing wrong.

Thanks again and have a happy weekend!!