How to make a dynamic table(dynamic rows and columns) using VBA code

[alihadi]

Hi all,

Does anyone know how to make a dynamic table using VBA code with head named columns and rows. Thanks in advance for the help.

[Paul_Hossler]

I think this is what you were asking

Since there are some restrictions on .Names names I had to add the MakeASCII function

It adds a .Name = "Sheet1_Data" the cells A1 CurrentRegion on Sheet1

=OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),COUNTA(Sheet1!$1:$1))





Sub NameAddDynamic()
Dim s As String, N As String

N = MakeASCII(ActiveSheet.Name)

With ActiveSheet
s = "=OFFSET("
s = s & "'" & .Name & "'!" & .Cells(1, 1).Address(True, True) & ",0,0,"
s = s & "COUNTA("
s = s & "'" & .Name & "'!" & .Cells(1, 1).EntireColumn.Address(True, True) & "),"
s = s & "COUNTA("
s = s & "'" & .Name & "'!" & .Cells(1, 1).EntireRow.Address(True, True) & "))"

.Parent.Names.Add Name:=N & "_Data", RefersTo:=s
End With
End Sub
Private Function MakeASCII(s As String) As String
Dim i As Long
Dim s1 As String, c As String

c = Left(s, 1)

Select Case c
Case "0" To "9"
s = "_" & s
Case Else
s = s
End Select

For i = 1 To Len(s)

c = Mid(s, i, 1)

Select Case c
Case "a" To "z", "A" To "Z", "0" To "9", "_"
s1 = s1 & c
Case " "
s1 = s1 & "_"
End Select
Next i
MakeASCII = s1
End Function

[SamT]

This will fake it.
Code for DataTable Sheet:

Public Function GetRangeByName(DesiredColumn As String) As Range
Dim Rng As Range

Set Rng = Rows(1).Find(DesiredColumn)
If Rng Is Nothing Then Exit Function
If Rng.End(xlDown).Row = Rows.Count Then Exit Function

Set GetRangeByName = Range(Rng.Offset(1), Cells(Rows.Count, Rng.Column).End(xlUp))

End Function

Code in other place:

Sub Demo()
Dim RngByHeader As Range

Set RngByHeader = Sheets(Data).GetRangeByName(MyHeaderName)

If RngByHeader Is Nothing Then MsgBox "That Column is empty or does not exist"

End Sub

[alihadi]

Thanks for your answer both, but the codes are not working, please help me.

[snb]

Apparently more isn't working....

[Paul_Hossler]

@alihadi -- It would help us if you could post a small workbook with more details of what you're looking for

[alihadi]

Hi,


I want to create a dynamic table as in the attached file. this table which in the file has 5 layers(H1, H2, H3, H4, H5) each layer has 15 columns and 10 rows. I want to generate a table like this table but dynamically in VBA code. so if i wanted to create a table has the same layers but different number of columns and rows for example 10 columns and 5 rows. I will be grateful if yiu can help me. Thanks in advance.

[Paul_Hossler]

Maybe something like this




Option Explicit
Sub DynamicTable()
Dim iNumH As Variant, iNumPerH As Variant, iNumCol As Variant
Dim wsTable As Worksheet
Dim i As Long, j As Long
Dim rTable As Range

'get inputs or get out
iNumH = InputBox("How many H groups?, 0 to exit", "Dynamic Tables")
If Len(iNumH) = 0 Or iNumH < 1 Then Exit Sub

iNumPerH = InputBox("How many row in each H group?, 0 to exit", "Dynamic Tables")
If Len(iNumPerH) = 0 Or iNumPerH < 1 Then Exit Sub

iNumCol = InputBox("How many columns?, 0 to exit", "Dynamic Tables")
If Len(iNumCol) = 0 Or iNumCol < 1 Then Exit Sub

Application.ScreenUpdating = False


'add new sheet
ActiveWorkbook.Worksheets.Add
Set wsTable = ActiveSheet
With wsTable
'first row
.Cells(1, 1).Value = "L"
.Cells(1, 2).Value = "R/B"
For i = 1 To iNumCol
.Cells(1, 2 + i).Value = i
Next i


'H blocks
'first block for H1
For i = 1 To iNumH
For j = 1 To iNumPerH
.Cells((i - 1) * iNumPerH + 1 + j, 2).Value = j
Next j

With Range(.Cells((i - 1) * iNumPerH + 2, 1), .Cells(i * iNumPerH + 1, 1))
.MergeCells = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

.Cells((i - 1) * iNumPerH + 2, 1).Value = "H" & i
Next i

Set rTable = .Cells(1, 1).CurrentRegion

End With

With rTable

Call pvtBorder(.Borders(xlEdgeTop), xlMedium)
Call pvtBorder(.Borders(xlEdgeRight), xlMedium)
Call pvtBorder(.Borders(xlEdgeBottom), xlMedium)
Call pvtBorder(.Borders(xlEdgeLeft), xlMedium)
Call pvtBorder(.Borders(xlInsideVertical), xlThin)
Call pvtBorder(.Borders(xlInsideHorizontal), xlThin)

With .Rows(1)
Call pvtBorder(.Borders(xlEdgeTop), xlMedium)
Call pvtBorder(.Borders(xlEdgeRight), xlMedium)
Call pvtBorder(.Borders(xlEdgeBottom), xlMedium)
Call pvtBorder(.Borders(xlEdgeLeft), xlMedium)
Call pvtBorder(.Borders(xlInsideVertical), xlMedium)
Call pvtBorder(.Borders(xlInsideHorizontal), xlMedium)
.Font.Bold = True
End With

With .Columns(1).Resize(, 2)
Call pvtBorder(.Borders(xlEdgeTop), xlMedium)
Call pvtBorder(.Borders(xlEdgeRight), xlMedium)
Call pvtBorder(.Borders(xlEdgeBottom), xlMedium)
Call pvtBorder(.Borders(xlEdgeLeft), xlMedium)
Call pvtBorder(.Borders(xlInsideVertical), xlMedium)
Call pvtBorder(.Borders(xlInsideHorizontal), xlMedium)
.Font.Bold = True
End With
For i = 1 To .Rows.Count Step iNumPerH
Call pvtBorder(.Rows(i).Borders(xlEdgeBottom), xlMedium)
Next i
End With
Application.ScreenUpdating = True
End Sub

Private Sub pvtBorder(B As Border, W As Long)
With B
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = W
End With
End Sub

[alihadi]

Thanks so much Paul for your help, I appreciate it.

[snb]

I'd suggest to create a template (save you sample as .xltx )

[Paul_Hossler]

Thinking about it, I realized I could simplify the code a bit in the .Borders area





Option Explicit
Sub DynamicTable()
Dim iNumH As Variant, iNumPerH As Variant, iNumCol As Variant
Dim wsTable As Worksheet
Dim i As Long, j As Long
Dim rTable As Range

'get inputs or get out
iNumH = InputBox("How many H groups?, 0 to exit", "Dynamic Tables")
If Len(iNumH) = 0 Or iNumH < 1 Then Exit Sub

iNumPerH = InputBox("How many row in each H group?, 0 to exit", "Dynamic Tables")
If Len(iNumPerH) = 0 Or iNumPerH < 1 Then Exit Sub

iNumCol = InputBox("How many columns?, 0 to exit", "Dynamic Tables")
If Len(iNumCol) = 0 Or iNumCol < 1 Then Exit Sub

Application.ScreenUpdating = False


'add new sheet
ActiveWorkbook.Worksheets.Add
Set wsTable = ActiveSheet
With wsTable
'first row
.Cells(1, 1).Value = "L"
.Cells(1, 2).Value = "R/B"
For i = 1 To iNumCol
.Cells(1, 2 + i).Value = i
Next i


'H blocks
'first block for H1
For i = 1 To iNumH
For j = 1 To iNumPerH
.Cells((i - 1) * iNumPerH + 1 + j, 2).Value = j
Next j

With Range(.Cells((i - 1) * iNumPerH + 2, 1), .Cells(i * iNumPerH + 1, 1))
.MergeCells = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

.Cells((i - 1) * iNumPerH + 2, 1).Value = "H" & i
Next i

Set rTable = .Cells(1, 1).CurrentRegion

End With

With rTable
.Borders.Weight = xlMedium
.Borders.LineStyle = xlContinuous
.Borders.ColorIndex = 0
.Borders.TintAndShade = 0

.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin

.Rows(1).Borders.Weight = xlMedium
.Rows(1).Font.Bold = True

.Columns(1).Resize(, 2).Borders.Weight = xlMedium
.Columns(1).Resize(, 2).Font.Bold = True
For i = 1 To .Rows.Count Step iNumPerH
.Rows(i).Borders(xlEdgeBottom).Weight = xlMedium
Next i
End With
Application.ScreenUpdating = True
End Sub

[alihadi]

Thanks Paul for your assistance. I need your help in how to generate random numbers within this dynamic table. Thanks in advance.

[Paul_Hossler]

Thanks Paul for your assistance. I need your help in how to generate random numbers within this dynamic table. Thanks in advance.

Sure

All cells?

Random between 0.0 and 1.0?

[alihadi]

Yes Paul please.

[Paul_Hossler]

Just add the line marked with <<<<<<<




With rTable
.Borders.Weight = xlMedium
.Borders.LineStyle = xlContinuous
.Borders.ColorIndex = 0
.Borders.TintAndShade = 0

.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin

.Rows(1).Borders.Weight = xlMedium
.Rows(1).Font.Bold = True

.Columns(1).Resize(, 2).Borders.Weight = xlMedium
.Columns(1).Resize(, 2).Font.Bold = True
For i = 1 To .Rows.Count Step iNumPerH
.Rows(i).Borders(xlEdgeBottom).Weight = xlMedium
Next I

.Cells(2, 3).Resize(.Rows.Count - 1, .Columns.Count - 2).Formula = "=RAND()" '<<<<<<<<<<<<<<<<<<<<<<<

'uncomment this line if you want to fix the values
' .Cells(2, 3).Resize(.Rows.Count - 1, .Columns.Count - 2).Value = .Cells(2, 3).Resize(.Rows.Count - 1, .Columns.Count - 2).Value
End With

[snb]

Alternative:


Sub M_snb()
sn = Array(, , , 0)
For j = 1 To 3
Do
sn(j) = InputBox("How many " & Choose(j, "H groups", "rows in each H group", "columns") & " ?", "Dynamic Tables")
If sn(j) = "" Then Exit Sub
Loop Until Val(sn(j)) > 0
Next

ReDim sp(1 To sn(1) * sn(2) + 1, 1 To sn(3) + 2)

sp(1, 1) = "L"
sp(1, 2) = "R/B"
For jj = 3 To UBound(sp, 2)
sp(1, jj) = jj - 2
Next
For j = 2 To UBound(sp)
sp(j, 1) = IIf((j - 1) Mod sn(2) + 1 = 2, "H" & (j - 1) \ sn(2) + 1, " ")
sp(j, 2) = (j - 2) Mod sn(2) + 1
Next

With Sheets.Add(, Sheets(Sheets.Count)).Cells(1).Resize(UBound(sp), UBound(sp, 2))
.Value = sp
.SpecialCells(4).Interior.ColorIndex = 14
.SpecialCells(4) = "=rand()"
End With
End Sub

[alihadi]

Thanks too much everybody for the help...

[alihadi]

Thanks Paul for the assistance, I need your help in the same dynamic table that you created, I want to do the folowing in VBA:
1. Generate random number between 0.00 and 1.0 in the columns and rows of the first H1.
2. Generate random time between 13:00 and 22:00 in the columns and row of the second H2.
3. Generate random date in the columns and rows of the third H3
4. Generate random number between 10 and 100 in the columns and rows of the fourth H4.
5. Generate random letter in the columns and rows of the fifth H5.
I attached an excel file how I want the above things.
Thanks in advance Paul.

[snb]

Is this an assignment ?

[alihadi]

Yes

[Paul_Hossler]

Ahhh - we really don't do homework here. If there's a specific question, that's different

But if you work with the example in #15, it should get you started

[alihadi]

Hi snb, I need your help please

[bbuk9999]

Hi, I need your help Paul...