'VBA Displaying Cell Reference and Table Range

So i have this userform that allows the user to key in the number of creditors and the number of rows for the table, then after the user clicks confirm, it will generate based on the input values

And now I need this details like which cell contains creditor name 1 and which range is creditor name 1 table like this picture below:

enter image description here

My current code is

'Clears Sheet then generates Number of Creditors & Rows
Worksheets("Payable Conf - by Invoice").Cells.Clear

Dim CreditorsCount As Integer
Dim Counter As Integer
Dim Rows As Integer

If TextBox1.Text <> "" And TextBox2.Text <> "" Then
CreditorsCount = TextBox1.Value
Counter = 0
CreditorsCount2 = 0
Rows = TextBox2.Value
End If

Worksheets("Payable Conf - by Invoice").Activate
    
While Counter < CreditorsCount
Cells((Counter * (5 + Rows) + 1), 1).Activate
        
With Range(ActiveCell.Address, ActiveCell.Offset(0, 4))
.Value = Array("Creditor Name " & CStr(Counter + 1), "Creditor Address 1", "Creditor Address 2", "Creditor Address 3", "Staff Email (e.g. [email protected])")
.Font.Bold = True
End With

With Range(ActiveCell.Offset(3, 0), ActiveCell.Offset(3, 2))
.Value = Array("Invoice No.", "Invoice Date", "Amount (e.g. $100)")
.Font.Bold = True
End With
        
With Union(Range(ActiveCell.Address, ActiveCell.Offset(1, 4)), Range(ActiveCell.Offset(3, 0), ActiveCell.Offset(3 + Rows, 2)))
.BorderAround XlLineStyle.xlContinuous, xlThin
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
        
Counter = Counter + 1

Wend
        
Worksheets("Payable Conf - by Invoice").Range("I8") = "Please do not edit"
Worksheets("Payable Conf - by Invoice").Range("I9") = "Number of Creditors:"
Worksheets("Payable Conf - by Invoice").Range("J9") = TextBox1.Value
Worksheets("Payable Conf - by Invoice").Range("I10") = "Number of Rows:"
Worksheets("Payable Conf - by Invoice").Range("J10") = TextBox2.Value

Help is greatly appreciated :)



Solution 1:[1]

Maybe something like this ?

Sub test()
Dim rg1 As Range
Dim rg2 As Range
Dim cnt As Integer
Dim TotRow As Integer
Dim tbl As Range

cnt = 5
TotRow = 10

With Sheets("Payable Conf - by Invoice")
    '.Activate
    .Cells.Delete
    Set rg1 = .Range("A1")
    Set rg2 = .Range("i8")
End With

With rg2
    .Resize(3, 1).Value = Application.Transpose(Array("do not edit", "num cred", "num rows"))
    .Offset(1, 1).Value = cnt
    .Offset(2, 1).Value = TotRow
    Set rg2 = rg2.Offset(4, 0)
End With

For i = 1 To cnt
    With rg1.Resize(1, 5)
        .Value = Array("cr name " & CStr(i), "add1", "add2", "add3", "email")
        .Font.Bold = True
        .Resize(2, 5).Borders.LineStyle = xlContinuous
    End With

Set rg1 = rg1.Offset(3, 0)
    With rg1.Resize(1, 3)
        .Value = Array("Inv No", "Inv Date", "Inv Amount")
        .Font.Bold = True
        Set tbl = .Resize(TotRow + 1, 3)
        tbl.Borders.LineStyle = xlContinuous
    End With

    With rg2
        .Offset(0, 0).Value = "cred name " & CStr(i) & ":"
        .Offset(0, 1).Value = rg1.Offset(-2, 0).Address(0, 0)
        .Offset(1, 0).Value = "tbl " & CStr(i) & ":"
        .Offset(1, 1).Value = tbl.Address(0, 0)
    End With

Set rg1 = rg1.Offset(TotRow + 2, 0)
Set rg2 = rg2.Offset(3, 0)
Next i

End Sub

Please try to run the sub on a new workbook.
If the result is the one that you expected, just change the cnt variable value and the TotRow variable value to your TextBox1.value and TextBox2.value

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1