none
Excel VBA - Union(.range in for-next loop with r1c1 reference gives Error RRS feed

  • Question

  • Hi,

    I am using Excel 2013 Professional Plus. Now I am writing a macro that gives me the Error:

    Laufzeitfehler '5':
    Ungültiger Prozeduraufruf oder ungültiges Argument

    Runtimeerror '5':
    Invalid procedure call or invalid argument

    at this line:

    For i = 1 To n            
        Set Matrizen = Union(Matrizen, .Range(.Cells(z(i) + 1, 2), .Cells(z(i + 1) - 1, 18)))        
    Next i


    Because the code is not running I am not sure how many problems I might be facing:

    1. Can the ranges already being part of 'Matrizen' (e.g. for i = 2) be re-called in the Union again? (Just like a = a + 1)

    2. Is the term .Cells(row,col) returning the value or the address of the Cell? Because for a range I need the addresses right?

    3. Maybe even more issues?

    Now the ultimate question is: What is the corret syntax for this line to work properly with the intention I have? Here is the entire code:

    Option Explicit
        
    Sub FindGrayCells_2()
    
        Dim Wb As Workbook: Set Wb = ThisWorkbook
        Dim Ws As Worksheet: Set Ws = Wb.ActiveSheet
        Dim Matrizen As Range
        Dim Dic As Object, RegEx As Object
        Dim z(), ZellInfos(), a
        Dim x&, i&, j&, n&, m&, o&, spalte&, zeile&
        Dim KontrollNachricht, As String
        
        n = 0
        m = 0
        o = 0
        
        Application.ScreenUpdating = False
        Set Dic = CreateObject("Scripting.Dictionary")
        Set RegEx = CreateObject("vbscript.regexp")
        
        With RegEx
            .Pattern = "(\[+?(?:[^\[\]\r\n]+?)\]+)" 
            .Global = True
            .MultiLine = False
        End With
        
        With Ws
            For x = 1 To 1000
                If .Cells(x, 2).MergeArea.Columns.Count = 17 Then
                    n = n + 1
                    ReDim Preserve z(n)
                    z(n) = x
                End If
            Next x
    
            'Put all the differernt ranges into one
            For i = 1 To n
                Set Matrizen = Union(Matrizen, .Range(.Cells(z(i) + 1, 2), .Cells(z(i + 1) - 1, 18)))
            Next i
            
            For i = 1 To Matrizen.Areas.Count
                a = Matrizen.Areas(i)
                For zeile = LBound(a, 1) To UBound(a, 1)
                        o = o + 1
                    For spalte = LBound(a, 2) To UBound(a, 2)
                        m = m + 1
                        ReDim Preserve ZellInfos(m, 6)
                        
                        'Value first way
                        Dic.Add a(zeile + 1, spalte + 1), ""
                        'Value second way
                        ZellInfos(m, 4) = a(zeile + 1, spalte + 1).Value
                        'Range Name
                        ZellInfos(m, 1) = a(-1, 2).Value
                        'Row Name
                        ZellInfos(m, 2) = a(zeile + 1, 1).Value
                        'Column Name
                        ZellInfos(m, 3) = a(zeile, spalte + 1).Value
                        'Cell BG Color
                        ZellInfos(m, 5) = a(zeile + 1, spalte + 1).Interior.Color
                        'Does cell content include square bracets?
                        If RegEx.Test(a(zeile + 1, spalte + 1)) Then
                            ZellInfos(m, 6) = "Control"
                        End If
                        For j = 1 To 6
                            KontrollNachricht = KontrollNachricht & ZellInfos(m, j) & vbNewLine
                        Next j
                        MsgBox "Hier die Kontrollausgabe:" & vbNewLine & KontrollNachricht
                    Next spalte
                Next zeile
            Next i
        End With
        
        'ToDo: Post data in sheet 'NEW'
            
        Erase z: Erase ZellInfos
            
    Allcellsareempty:
        Set Wb = Nothing
        Set Ws = Nothing
        Set Dic = Nothing
        
        Application.ScreenUpdating = True
    
    
    End Sub



    Wednesday, July 12, 2017 11:33 AM

All replies

  • Runtimeerror '5':

    Invalid procedure call or invalid argument

    at this line:

    For i = 1 To n            
        Set Matrizen = Union(Matrizen, .Range(.Cells(z(i) + 1, 2), .Cells(z(i + 1) - 1, 18)))        
    Next i

    The reason is that Matrizen is Nothing at the first run, same issue as in this code:

    Sub TestA()
      Dim R As Range
      Set R = Union(R, Range("A1"))
    End Sub

    If you initialize R first, it works:
    Sub TestB()
      Dim R As Range
      Set R = Range("A2")
      Set R = Union(R, Range("A1"))
    End Sub

    BTW, I guess you'll find the code below interesting / helpful.

    Andreas.

    Function FindAll(ByVal Where As Range, ByVal What, _
        Optional ByVal After As Variant, _
        Optional ByVal LookIn As XlFindLookIn = xlValues, _
        Optional ByVal LookAt As XlLookAt = xlWhole, _
        Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _
        Optional ByVal SearchDirection As XlSearchDirection = xlNext, _
        Optional ByVal MatchCase As Boolean = False, _
        Optional ByVal SearchFormat As Boolean = False) As Range
      'Find all occurrences of What in Where (Windows version)
      Dim FirstAddress As String
      Dim c As Range
      'From FastUnion:
      Dim Stack As New Collection
      Dim Temp() As Range, Item
      Dim i As Long, j As Long
    
      If Where Is Nothing Then Exit Function
      If SearchDirection = xlNext And IsMissing(After) Then
        'Set After to the last cell in Where to return the first cell in Where in front if _
          it match What
        Set c = Where.Areas(Where.Areas.Count)
        'BUG in XL2010: Cells.Count produces a RTE 6 if C is the whole sheet
        'Set After = C.Cells(C.Cells.Count)
        Set After = c.Cells(c.Rows.Count * CDec(c.Columns.Count))
      End If
    
      Set c = Where.Find(What, After, LookIn, LookAt, SearchOrder, _
        SearchDirection, MatchCase, SearchFormat:=SearchFormat)
      If c Is Nothing Then Exit Function
    
      FirstAddress = c.Address
      Do
        Stack.Add c
        If SearchFormat Then
          'If you call this function from an UDF and _
            you find only the first cell use this instead
          Set c = Where.Find(What, c, LookIn, LookAt, SearchOrder, _
            SearchDirection, MatchCase, SearchFormat:=SearchFormat)
        Else
          If SearchDirection = xlNext Then
            Set c = Where.FindNext(c)
          Else
            Set c = Where.FindPrevious(c)
          End If
        End If
        'Can happen if we have merged cells
        If c Is Nothing Then Exit Do
      Loop Until FirstAddress = c.Address
    
      'FastUnion algorithm © Andreas Killer, 2011:
      'Get all cells as fragments
      ReDim Temp(0 To Stack.Count - 1)
      i = 0
      For Each Item In Stack
        Set Temp(i) = Item
        i = i + 1
      Next
      'Combine each fragment with the next one
      j = 1
      Do
        For i = 0 To UBound(Temp) - j Step j * 2
          Set Temp(i) = Union(Temp(i), Temp(i + j))
        Next
        j = j * 2
      Loop Until j > UBound(Temp)
      'At this point we have all cells in the first fragment
      Set FindAll = Temp(0)
    End Function

    Wednesday, July 12, 2017 4:53 PM
  • Hi Andreas,

    thank you very much. I'll test your concrete answer and the code you provided.

    Thanks.

    Thursday, July 13, 2017 7:22 AM