I have a set of data that Id like to automate filling in a table full of string data, based on a given input value, that will add/remove rows as necessary to allow space, and bonus points if I can merge the input value cell to the size of the added list.

As an example for the reference below:

It would output this table, which would update under Cell 4 if i added a cell 5 to Data 1 or at the end if i add a Cell 3 to Data 2

Ive attempted using some index functions with match but cant quite get it to work.

Using this string gets me the references in the format id like, but 'spills' and repeats the references/data many times for Data 1, ignoring if i try to enter a Data2 line. =IFERROR(INDEX($B$2:$B$12,SMALL(IF($A$2:$A$100=H$2,ROW($A$2:$A$100)-1),ROW(1:1)),1),"")

this doesnt get me to merging cells, but even if i could autopopulate these references it would be nice.

tried a few merge options in vba but cant get it consistent.

excel 365, macros available

CodePudding user response：

Have you tried using power query (get data)? With just a few clicks I was able to produce the below from the example you gave. I included the steps below to achieve what I show. Power query is a good data to table manipulation tool inside of Excel. After creating the table once, all that needs to be done is refresh it once new data is added. The table would then adjust to the new data.

= Excel.CurrentWorkbook(){[Name="Table1"]}[Content]

= Table.SplitColumn(Source, "Column2", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"Column2.1", "Column2.2", "Column2.3", "Column2.4"})

= Table.UnpivotOtherColumns(#"Split Column by Delimiter", {"Column1"}, "Attribute", "Value")

= Table.RemoveColumns(#"Unpivoted Columns",{"Attribute"})

CodePudding user response：

Before:

After:

Sub SplitAll()
Dim xRg As Range
Dim xRg1 As Range
Dim xCell As Range
Dim I As Long
Dim xAddress As String
Dim xUpdate As Boolean
Dim xRet As Variant
On Error Resume Next
xAddress = Application.ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("Please select a range", "Kutools for Excel", xAddress, , , , , 8)
Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
If xRg Is Nothing Then Exit Sub
    If xRg.Columns.Count > 1 Then
        MsgBox "You can't select multiple columns", , "Kutools for Excel"
        Exit Sub
        End If
        Set xRg1 = Application.InputBox("Split to (single cell):", "Kutools for Excel", , , , , , 8)
        Set xRg1 = xRg1.Range("A1")
        If xRg1 Is Nothing Then Exit Sub
            xUpdate = Application.ScreenUpdating
            Application.ScreenUpdating = False
            For Each xCell In xRg
                xRet = Split(xCell.Value, ",")
                xRg1.Worksheet.Range(xRg1.Offset(I, 0), xRg1.Offset(I   UBound(xRet, 1), 0)) = Application.WorksheetFunction.Transpose(xRet)
                I = I   UBound(xRet, 1)   1
            Next
            Application.ScreenUpdating = xUpdate
End Sub

Also, see this.

https://www.automateexcel.com/how-to/split-text-to-rows/