I have a macro that currently creates 2 tables across 2 sheets. One table works fine, that is located on the Instructions page. The other table is dynamically created on another sheet, it also works fine. However I want this table to have a row above it with the name of the table in it. So end result, table is generated when macro is ran with the name of the Table above the table.
The macro currently asks the user to name the Table (Supply Chain), which is updated as the actual table name in the Name Manager. That is the varible (Y) that I want to be in the row above the generated table in the Dynamic Table section of this code.
Sub GenerateSupplyChain2()
Worksheets("JP8").Columns("D").ClearContents
Worksheets("JP8").Range("D6:D300").FormulaR1C1 = "=VLOOKUP(RC[+1],S1CODE,2,0)"
Worksheets("JP5").Columns("D").ClearContents
Worksheets("JP5").Range("D6:D300").FormulaR1C1 = "=VLOOKUP(RC[+1],S2CODE,2,0)"
Worksheets("F76").Columns("D").ClearContents
Worksheets("F76").Range("D6:D300").FormulaR1C1 = "=VLOOKUP(RC[+1],S3CODE,2,0)"
Worksheets("JA1").Columns("D").ClearContents
Worksheets("JA1").Range("D6:D300").FormulaR1C1 = "=VLOOKUP(RC[+1],S4CODE,2,0)"
Worksheets("JAA").Columns("D").ClearContents
Worksheets("JAA").Range("D6:D300").FormulaR1C1 = "=VLOOKUP(RC[+1],S5CODE,2,0)"
Dim Y As Variant
Y = InputBox("Name your Supply Chain")
Dim counterSheet As Worksheet
Set counterSheet = Sheets("CounterSheet")
Dim lastColumn As Long
lastColumn = counterSheet.Cells(2, counterSheet.Columns.Count).End(xlToLeft).Column
If lastColumn = 1 And IsEmpty(counterSheet.Cells(2, 1).Value) Then
counterSheet.Cells(2, 1).Value = 1
Else
counterSheet.Cells(2, lastColumn + 1).Value = counterSheet.Cells(2, lastColumn).Value + 1
End If
Dim Z As Long
Z = counterSheet.Cells(2, lastColumn).Value
''instructions page
Const COL_CNT = 4 ' cols count of the table (ListObject)
Const COL_KEY = "AA" ' used to determine the last row
Const FIRST_ROW = 5
Dim i As Variant
i = InputBox("How many DFSP's in this Supply Chain?", "Enter Quantity")
If Not IsNumeric(i) Then
MsgBox "Please input a number.", vbCritical
Exit Sub
End If
If i < 1 Then Exit Sub
Dim sht As Worksheet
Dim LastRow As Long
Set sht = Worksheets("Instructions")
LastRow = sht.Cells(sht.Rows.Count, COL_KEY).End(xlUp).Row
With sht.Cells(LastRow, COL_KEY)
If Len(.Value) > 0 Or (Not .ListObject Is Nothing) Then
LastRow = LastRow + 1
End If
If LastRow < FIRST_ROW Then LastRow = 5
End With
Dim tabRng As Range
Set tabRng = sht.Cells(LastRow, COL_KEY).Resize(i + 1, COL_CNT)
Dim objTable As ListObject
Set objTable = ActiveSheet.ListObjects.Add(xlSrcRange, tabRng, , xlYes)
objTable.HeaderRowRange.Value = Array("Numeric", "Name", "Alpha", "Location") ' for testing
objTable.TableStyle = "TableStyleLight1"
objTable.DataBodyRange.Columns(1).Value = Z
objTable.DataBodyRange.Cells(1, 3).formula = _
"=D5"
objTable.DataBodyRange.Columns(2).Value = Y
'dynamic page
Dim MySheet As String, ws As Worksheet
MySheet = Sheets("Instructions").Range("AF1").Value
Set ws = Sheets(MySheet)
Const COL_KEY1 = "E" ' used to determine the last row
Const FIRST_ROW1 = 6
Const HEADER_RNG = "D2:AZ2" ' source of header
Const BASE_SHT = "Base Data"
Dim oSht As Worksheet, LastRow1 As Long
Set oSht = Sheets(MySheet)
LastRow1 = oSht.Cells(oSht.Rows.Count, COL_KEY1).End(xlUp).Row
With oSht.Cells(LastRow1, COL_KEY1)
If Len(.Value) > 0 Or (Not .ListObject Is Nothing) Then
LastRow1 = LastRow1 + 3
End If
If LastRow1 < FIRST_ROW1 Then LastRow1 = FIRST_ROW1
End With
Dim tabRng1 As Range, headerRng As Range, objTable1 As ListObject
Set headerRng = Sheets("BASE Data").Range(HEADER_RNG)
Set tabRng1 = oSht.Cells(LastRow1, COL_KEY1).Resize(i + 1, headerRng.Columns.Count)
Set objTable1 = Worksheets(MySheet).ListObjects.Add(xlSrcRange, tabRng1, , xlYes)
objTable1.HeaderRowRange.Value = headerRng.Value
objTable1.ShowTotals = True
objTable1.TableStyle = "TableStyleLight1"
objTable1.TotalsRowRange.Cells.Interior.Color = RGB(217, 217, 217)
objTable1.TotalsRowRange.Cells.Font.Bold = True
objTable1.TotalsRowRange.Cells.HorizontalAlignment = xlCenter
objTable1.TotalsRowRange.Cells.VerticalAlignment = xlCenter
objTable1.HeaderRowRange.Cells.Interior.Color = RGB(166, 166, 166)
With objTable1.ListColumns(1).DataBodyRange
.Value = objTable1.Parent.Range("CB5").Resize(.Rows.Count).Value
End With
objTable1.DataBodyRange.Cells(1, 2).formula = _
"=INDIRECT(""RC[-2]"",0)"
objTable1.DataBodyRange.Cells(1, 3).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,2,FALSE)"
objTable1.DataBodyRange.Cells(1, 4).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,3,FALSE)"
objTable1.DataBodyRange.Cells(1, 5).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,4,FALSE)"
objTable1.DataBodyRange.Cells(1, 6).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,5,FALSE)"
objTable1.DataBodyRange.Cells(1, 7).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,6,FALSE)"
objTable1.DataBodyRange.Cells(1, 8).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,7,FALSE)"
objTable1.DataBodyRange.Cells(1, 9).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,8,FALSE)"
objTable1.DataBodyRange.Cells(1, 10).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,9,FALSE)"
objTable1.DataBodyRange.Cells(1, 11).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,10,FALSE)"
objTable1.DataBodyRange.Cells(1, 12).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,11,FALSE)"
objTable1.DataBodyRange.Cells(1, 13).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,12,FALSE)"
objTable1.DataBodyRange.Cells(1, 14).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,13,FALSE)"
objTable1.DataBodyRange.Cells(1, 15).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,14,FALSE)"
objTable1.DataBodyRange.Cells(1, 16).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,15,FALSE)"
objTable1.DataBodyRange.Cells(1, 17).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,16,FALSE)"
objTable1.DataBodyRange.Cells(1, 18).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,17,FALSE)"
objTable1.DataBodyRange.Cells(1, 19).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,18,FALSE)"
objTable1.DataBodyRange.Cells(1, 20).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,19,FALSE)"
objTable1.DataBodyRange.Cells(1, 21).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,20,FALSE)"
objTable1.DataBodyRange.Cells(1, 22).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,21,FALSE)"
objTable1.DataBodyRange.Cells(1, 23).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,22,FALSE)"
objTable1.DataBodyRange.Cells(1, 24).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,23,FALSE)"
objTable1.DataBodyRange.Cells(1, 25).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,24,FALSE)"
objTable1.DataBodyRange.Cells(1, 26).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,25,FALSE)"
objTable1.DataBodyRange.Cells(1, 27).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,26,FALSE)"
objTable1.DataBodyRange.Cells(1, 28).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,27,FALSE)"
objTable1.DataBodyRange.Cells(1, 29).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,28,FALSE)"
objTable1.DataBodyRange.Cells(1, 30).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,29,FALSE)"
objTable1.DataBodyRange.Cells(1, 31).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,30,FALSE)"
objTable1.DataBodyRange.Cells(1, 32).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,31,FALSE)"
objTable1.DataBodyRange.Cells(1, 33).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,32,FALSE)"
objTable1.DataBodyRange.Cells(1, 34).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,33,FALSE)"
objTable1.DataBodyRange.Cells(1, 35).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,34,FALSE)"
objTable1.DataBodyRange.Cells(1, 36).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,35,FALSE)"
objTable1.DataBodyRange.Cells(1, 37).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,36,FALSE)"
objTable1.DataBodyRange.Cells(1, 38).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,37,FALSE)"
objTable1.DataBodyRange.Cells(1, 39).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,38,FALSE)"
objTable1.DataBodyRange.Cells(1, 40).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,39,FALSE)"
objTable1.DataBodyRange.Cells(1, 41).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,40,FALSE)"
objTable1.DataBodyRange.Cells(1, 42).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,41,FALSE)"
objTable1.DataBodyRange.Cells(1, 43).formula = _
"=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,42,FALSE)"
objTable1.Name = Y
Sheets(MySheet).HorizontalAlignment = xlCenter
Sheets(MySheet).VerticallAlignment = xlCenter
Sheets(MySheet).WrapText = True
Sheets(MySheet).Range("D5:AZ1000").Interior.Color = RGB(217, 217, 217)
End Sub
** With sht.Cells(LastRow, COL_KEY)
If Len(.Value) > 0 Or (Not .ListObject Is Nothing) Then
LastRow = LastRow + 1
End If
If LastRow < FIRST_ROW Then LastRow = 5
End With
sht.Cells(LastRow, COL_KEY) = Y ' **
Dim tabRng As Range
Set tabRng = sht.Cells(LastRow + 1, COL_KEY).Resize(i + 1, COL_CNT) ' **
btw, the code to apply VLOOKUP formula can be simplified with a For loop.
Dim j As Long, sFormula As String, dataRng As Range
Set dataRng = objTable1.DataBodyRange
sFormula = "=VLOOKUP([@[" & objTable1.HeaderRowRange.Cells(1, 2).Value & "]],'BASE Data'!E:AS,^%^,FALSE)"
For i = 2 To 42
dataRng.Cells(1, i + 1).Formula = Replace(sFormula, "^%^", CStr(i))
Next j