Using the select-case statement with cells within ranges

Question

My idea is to fill the cells on column H depending on what the corresponding cell in the range A:A,D:D,F:F contains.

I'm getting the run-time error 13 (type mismatch) on the line Case "Done" , though I'm not sure why, as both the selected range and the variable input are strings. I've always used if-loops, this is the first time I'm using select case , but despite having read the reference I still don't know what am I doing wrong.

The second question is how to define the last filled row of a range as the end of a new range. Right now with newRange.Value I'm attributing a value to the entire column, but I'm trying to make sure it only applies to the corresponding cell.

(For clarification, if for example cell A3 contains a value, that means D3 and F3 are empty, so each row in the range A:A,D:D,F:F only contains one value.)

Sub setStatus()

Dim dataRange As Range
Dim newRange As Range

Set dataRange = Range("A:A,D:D,F:F")
Set newRange = Range("H:H")

Select Case dataRange.Value

        Case "Done"
            newRange.Value = "Completed"
        Case "WIP"
            newRange.Value = "In Progress"
            'In reality there are many different cases, 
            'hence the select case instead of an if loop
        End Select
    Next

End Sub

Answer 1

Application.Match Applied on Array Instead of Select Case

Sub SetStatus()

    ' Constants
    Const SOURCE_FIRST_ROW As Long = 2
    Const DESTINATION_COLUMN As Long = 8
    ' Arrays
    Dim sCols() As Variant: sCols = VBA.Array(1, 4, 6) ' only one column has data
    Dim Cases() As Variant: Cases = VBA.Array( _
        "Done", "WIP")
    Dim Values() As Variant: Values = VBA.Array( _
        "Completed", "In Progress")
    
    ' Worksheet
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Write the values from the source range to an array.
    
    Dim srg As Range: Set srg = ws.UsedRange
    Dim rOffset As Long: rOffset = SOURCE_FIRST_ROW - 1
    Dim rCount As Long: rCount = srg.Rows.Count - rOffset
    Set srg = srg.Resize(rCount).Offset(rOffset)
    Dim Data As Variant: Data = srg.Value
    
    Dim cUpper As Long: cUpper = UBound(sCols)
    
    ' Write the matching results to the 1st column of the array.
    
    Dim r As Long
    Dim c As Long
    Dim cString As String
    Dim cIndex As Variant
    Dim HasDataInRow As Boolean
    
    For r = 1 To rCount ' rows of the array
        For c = 0 To cUpper ' given columns of the array
            cString = CStr(Data(r, sCols(c)))
            If Len(cString) > 0 Then
                cIndex = Application.Match(cString, Cases, 0)
                If IsNumeric(cIndex) Then
                    Data(r, 1) = Values(cIndex - 1) ' found in Cases
                Else
                    Data(r, 1) = Empty ' not found in Cases
                End If
                HasDataInRow = True
                Exit For
                'Else ' is blank; do nothing
            End If
        Next c
        If HasDataInRow Then
            HasDataInRow = False
        Else
            Data(r, 1) = Empty ' the row was blank
        End If
    Next r
            
    ' Write the values from the first column of the array
    ' to the destination range.
            
    Dim drg As Range: Set drg = srg.Columns(DESTINATION_COLUMN)
            
    drg.Value = Data
      
    MsgBox "Status set.", vbInformation

End Sub