'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:
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 |

