Richard J
Richard J

Reputation: 19

Union function works over a range but the Range function won't

I am attempting to select a continuous range inside of a table determined by variable references using VBA. I have run into an issue where I can use the Union function to select 2 points, but cannot use the Range function in order to create a continuous range.

For context, here is a sample of the code I am using:

For i = 1 to 5

     Set colrng = Table2.HeaderRowRange
     Set rowrng = Range(Range("B3"), Range("B" & CStr(2 + Table2.DataBodyRange.Rows.Count)))

     col = WorksheetFunction.Match(Table1.DataBodyRange(i, 1), colrng, 0)
     row = WorksheetFunction.Match(Table1.DataBodyRange(i, 4), rowrng, 0)

     Union(Table2.DataBodyRange(row, col), Table2.DataBodyRange(row + 2, col)) = "New Value"

Next

The code as of right now works, but results in 2 disjointed cells containing "New Value", whereas I would prefer if every cell between and inclusive of the two endpoints contained "New Value". The method I have used in the past on less advanced code utilizes the Range function, but that doesn't work here and yields an error:

Run-time error '1004':

Application-defined or object defined error

Edit: I don't think I was clear enough in my initial example, so below is the full code I am using.

Private Sub test()
    
    Dim colrng As Range
    Dim rowrng As Range
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim r As Integer
    Dim c As Integer
    Dim t As Double
    Dim Schedule As ListObject
    Dim Info As ListObject
    
    Set Schedule = Sheet1.ListObjects("Table1")
    Set Info = Sheet2.ListObjects("Table2")
    
    Schedule.DataBodyRange.ClearContents
    
    
    For i = 1 To Info.DataBodyRange.Rows.Count
        
        t = Info.DataBodyRange(i, 5) - 1
        
        Set colrng = Schedule.HeaderRowRange
        Set rowrng = Sheet1.Range(Sheet1.Range("B3"), Sheet1.Range("B" & CStr(2 + Schedule.DataBodyRange.Rows.Count)))
        
        If IsEmpty(Info.DataBodyRange(i, 4)) = False And IsEmpty(Info.DataBodyRange(i, 1)) = False Then
        
            c = Application.Match(Info.DataBodyRange(i, 1), colrng, 0)
            r = Application.Match(Info.DataBodyRange(i, 4), rowrng, 0)
            
            Range(Schedule.DataBodyRange(r, c), Schedule.DataBodyRange(r + t, c)) = Info.DataBodyRange(i, 2) & " - " & Info.DataBodyRange(i, 3)
            
        End If
    Next
End Sub

Where info is this table:

enter image description here

And the Schedule table with the desired output is:

enter image description here

As of right now, using the Union function in place of the Range function in the last row before the closing code I am able to generate all of the desired output aside from the cell D8 being empty.

Upvotes: 0

Views: 202

Answers (1)

Cyril
Cyril

Reputation: 6829

Given your comment, I believe your issue has to do with how to define a range and the below changes may support using Range() rather than union:

For i = 1 to 5
     Set colrng = Table2.HeaderRowRange
     Set rowrng = Range(Range("B3"), Range("B" & CStr(2 + Table2.DataBodyRange.Rows.Count)))
     'EDIT:  You start with cell B3, so adding col+1 and row+2
     col = Application.Match(Table1.DataBodyRange(i, 1), colrng, 0) + 1 'CHANGE
     row = Application.Match(Table1.DataBodyRange(i, 4), rowrng, 0) + 2 'CHANGE
     'range().value = "new value" and will utilize cells()
     Range(Cells(row, col+1), Cells(row + 2, col+1)).Value = "New Value" 'CHANGE
Next

Please remember to fully-qualify your references. In rowrng you just have range() references, but what sheet is that on? some of that info may have an impact depending on the layout and usage of your workbook.

Additionally, changed WorksheetFunction to Application which allows for different error handling. This may or may not be benefitial to you.

Upvotes: 3

Related Questions