how to apply match in loop in vba-CodePudding

I am completely stucked with applying match function in my code. This below is part only my code; previous part is copying cells / rows from sources to result sheet, and this planned function to check status of copy...happened or not If match, answer OK, if not, than let empty the cell. But simply not works and code stops each case at "res" and no idea what. Ive learned that match has problem if result is error, so Tried On error resume next, On error go to issues, Read same codes which works, but cannot see the problem in my one, however looking for about a week No idea and cannot move forward however sure that solution is quite simple only my knowledge is small. Thx for reading and support me

wsLCLHU is source worksheet - wsCallLCL is result

Sub Match()

Dim res As Variant
'firstrow is number of first visible row of copied range of source
FirstRow = foundrow
'lastrow is last nr of row of visible range of source 
LastRow = lastrowHU
    
    For row = LastRow To FirstRow Step -1
    res = Application.Match(wsLCLHU.Range("H" & foundrow & ":" & "H" & lastrowHU).SpecialCells(xlCellTypeVisible), wsCallLCL.Range("I:I"), 0)
        
                If IsError(res) Then
                    wsLCLHU.Range("CE" & row).Value = ""
                        Else
        
                    wsLCLHU.Range("CE" & row).Value = "OK"
            
        End If
       
    Next row

End Sub

CodePudding user response：

Not directly answering your question, but another trick to get around using match() would be assessment of the length of characters of your current element versus substituting a value within that element:

If Not Len(Replace(namedArray(Val),phrase) = Len(namedArray(Val)) then

This takes some particular phrase and assesses if it is removed from the value in your assessed element of the namedArray.

CodePudding user response：

I tried explaining in my above comment that Application.Match always returns an error if at least one of the range to be matched is discontinuous. In order to prove that, and also to give you a solution to use this matching way, I created a function able to convert a discontinuous range in a 2D array. Application.Match works similarly on arrays.

So, please use the next function:

Private Function arrFrDiscRng2D(Rng As Range) As Variant ' 1D array, super tare
  Dim arr As Variant, arr1, i As Long, j As Long, k As Long

  Dim A As Range
  ReDim arr(1 To Rng.cells.count, 1 To 1)
  For Each A In Rng.Areas
        arr1 = A.Value2
        If IsArray(arr1) Then
           For i = 1 To UBound(arr1)
                For j = 1 To UBound(arr1, 2)
                    arr(k, 1) = arr1(i, j): k = k   1
                Next j
           Next i
        Else
            arr(k, 1) = A.value: k = k   1
        End If
  Next A

And replace this part of your code:

 For row = LastRow To FirstRow Step -1
    res = Application.Match(wsLCLHU.Range("H" & foundrow & ":" & "H" & lastrowHU).SpecialCells(xlCellTypeVisible), wsCallLCL.Range("I:I"), 0)
        
                If IsError(res) Then
                    wsLCLHU.Range("CE" & row).Value = ""
                        Else
        
                    wsLCLHU.Range("CE" & row).Value = "OK"
            
        End If
       
    Next row

with this one, calling the above function:

    For row = lastRow To FirstRow Step -1
        Res = Application.match(arrFrDiscRng2D(wsLCLHU.Range("H" & foundRow & ":" & "H" & _
                              lastrowHU).SpecialCells(xlCellTypeVisible)), wsCallLCL.Range("I:I").Value2, 0)
        
        If IsError(Res) Then
                wsLCLHU.Range("CE" & row).value = ""
        Else
                wsLCLHU.Range("CE" & row).value = "OK"
        End If
       
    Next row