Populate a table based on a list of elements and attributes with vba

[IreneFoncillas]

Hi all,

I would like to write a vba code for two different actions, but I am not able to do it. Maybe there is a way to do it just in one action, so all your expertise will be welcome.

In one sheet (Sheet 1), I have a list with elements and their attributes (this list will be updated and the number of elements and attributes can change so the range won’t have the same size. Also each element does not have the same attributes, it can have one or several).
In another sheet (Sheet 2), I have a table with the elements in column A and the attributes in row 1.

I would like to check if the element has the attribute in Sheet 1, then write an X in the corresponding table cell.

My idea was to concatenate Element and Attribute, and write a formula in each cell of the table to look for that concatenation, but I am sure there is an easiest way to do it.

I attach one image for a better understanding.

Thank you very much for the help!

 

[excel_learnerz]

You can achieve this using VBA to loop through the data in Sheet1 and populate the corresponding cells in Sheet2 based on the Element-Attribute relationship. Here's a step-by-step guide to create the VBA code:

1. Press Alt + F11 to open the VBA editor.
2. Click on "Insert" > "Module" to insert a new module.
3. Paste the following code into the module:

Sub FillAttributesTable()
    Dim wsData As Worksheet, wsTable As Worksheet
    Dim lastDataRow As Long, lastDataCol As Long, lastTableCol As Long
    Dim element As String, attribute As String
    Dim i As Long, j As Long, k As Long

    Set wsData = ThisWorkbook.Worksheets("Sheet1")
    Set wsTable = ThisWorkbook.Worksheets("Sheet2")

    lastDataRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    lastDataCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column
    lastTableCol = wsTable.Cells(1, wsTable.Columns.Count).End(xlToLeft).Column

    Application.ScreenUpdating = False

    For i = 2 To lastDataRow
        element = wsData.Cells(i, 1).Value
        For j = 2 To lastDataCol
            attribute = wsData.Cells(1, j).Value
            If wsData.Cells(i, j).Value = "X" Then
                For k = 2 To lastTableCol
                    If wsTable.Cells(1, k).Value = attribute Then
                        wsTable.Cells(wsTable.Range("A:A").Find(element).Row, k).Value = "X"
                        Exit For
                    End If
                Next k
            End If
        Next j
    Next i

    Application.ScreenUpdating = True
End Sub

1. Replace "Sheet1" with the name of your worksheet that contains the list of elements and their attributes. Replace "Sheet2" with the name of the worksheet that contains the table.
2. Close the VBA editor.
3. Press Alt + F8 to open the "Macro" dialog box, select FillAttributesTable, and click "Run".

The VBA code will loop through the data in Sheet1 and populate the corresponding cells in Sheet2 based on the Element-Attribute relationship. This code will work with varying numbers of elements and attributes.

 

[IreneFoncillas]

Hi, thank you for your quick response. But I am afraid it doesn't work properly...

the word attribute seems to have a problem with the macro (it appears in red color and the macron does not run) so I changed it to the word parameter. I also changed it in the table header, in case it affects. The macro run without errors but the X is not filled in in the table.

I tested the vba code with the example provided but actually I have the element list in column F and the attributes (or parameters) in column U. I guess this affects and I am able to change column A to column F, but my knowledge is not so extensive as to know if it affects something else.

Thank you in advance!!

 

[excel_learnerz]

If you have changed the name of the attribute to "parameter" and updated the table header accordingly, you will need to modify the VBA code to use the new name when searching for the parameter in the table. Here's how you can modify the code:

Sub FillParametersTable()
    Dim wsData As Worksheet, wsTable As Worksheet
    Dim lastDataRow As Long, lastDataCol As Long, lastTableCol As Long
    Dim element As String, parameter As String
    Dim i As Long, j As Long, k As Long

    Set wsData = ThisWorkbook.Worksheets("Sheet1")
    Set wsTable = ThisWorkbook.Worksheets("Sheet2")

    lastDataRow = wsData.Cells(wsData.Rows.Count, "F").End(xlUp).Row
    lastDataCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column
    lastTableCol = wsTable.Cells(1, wsTable.Columns.Count).End(xlToLeft).Column

    Application.ScreenUpdating = False

    For i = 2 To lastDataRow
        element = wsData.Cells(i, 6).Value
        For j = 21 To lastDataCol
            parameter = wsData.Cells(1, j).Value
            If wsData.Cells(i, j).Value = "X" Then
                For k = 2 To lastTableCol
                    If wsTable.Cells(1, k).Value = parameter Then
                        wsTable.Cells(wsTable.Range("A:A").Find(element).Row, k).Value = "X"
                        Exit For
                    End If
                Next k
            End If
        Next j
    Next i

    Application.ScreenUpdating = True
End Sub

This code should work as expected, assuming that your data is in the same format as the example you provided, with elements in column F and parameters in column U. If your data is in different columns, you may need to adjust the column references in the code accordingly.

 

[IreneFoncillas]

Hi again, I tried the new code but still the X is not appearing in the table... I attach one image with my data and table (hope it helps)

I copied and pasted the vba code exactly as above, and sheets name are Sheet1 and Sheet2, so I don't understand if I am doing something wrong.

 

[excel_learnerz]

try,

Sub FillParametersTable()
    Dim wsData As Worksheet, wsTable As Worksheet
    Dim lastDataRow As Long, lastTableCol As Long, lastTableRow As Long
    Dim element As String, attribute As String
    Dim i As Long, j As Long, k As Long

    Set wsData = ThisWorkbook.Worksheets("Sheet1")
    Set wsTable = ThisWorkbook.Worksheets("Sheet2")

    lastDataRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    lastTableCol = wsTable.Cells(1, wsTable.Columns.Count).End(xlToLeft).Column
    lastTableRow = wsTable.Cells(wsTable.Rows.Count, "A").End(xlUp).Row

    Application.ScreenUpdating = False

    For i = 2 To lastDataRow
        element = wsData.Cells(i, 1).Value
        attribute = wsData.Cells(i, 2).Value

        Dim elementRow As Long, attributeCol As Long

        On Error Resume Next
        elementRow = wsTable.Range("A:A").Find(element).Row
        attributeCol = wsTable.Range("1:1").Find(attribute).Column
        On Error GoTo 0

        If elementRow > 0 And attributeCol > 0 Then
            wsTable.Cells(elementRow, attributeCol).Value = "X"
        End If
    Next i

    Application.ScreenUpdating = True
End Sub

 

[RoryA]

Don't use attribute as a variable name - VBA will not accept it.

 

[IreneFoncillas]

Hi,

I tried the new code with the first example (but changing attribute to parameter) and the table is populated but wrong. I attach an image with the result, and how it should look like.

Thanks for the help! I really appreciate it.

 

[IreneFoncillas]

Hi again,

I managed to fix the issue editing a little bit the vba code provided, but I found another issue that I am not able to fix.
If someone can help me I will appreciate it very much.

The vba code used:

Sub FillParametersTable()

    Dim wsData As Worksheet, wsTable As Worksheet
    Dim lastDataRow As Long, lastTableCol As Long, lastTableRow As Long
    Dim element As String, parameter As String
    Dim i As Long, j As Long, k As Long

    Set wsData = ThisWorkbook.Worksheets("Sheet1")
    Set wsTable = ThisWorkbook.Worksheets("Sheet2")

    lastDataRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    lastTableCol = wsTable.Cells(1, wsTable.Columns.Count).End(xlToLeft).Column
    lastTableRow = wsTable.Cells(wsTable.Rows.Count, "A").End(xlUp).Row

    Application.ScreenUpdating = False

    For i = 2 To lastDataRow
        element = wsData.Cells(i, 1).Value
        parameter = wsData.Cells(i, 2).Value

        Dim elementRow As Long, parameterCol As Long

        On Error Resume Next
        elementRow = wsTable.Range("A:A").Find(element, LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=True).Row
        parameterCol = wsTable.Range("1:1").Find(parameter, LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=True).Column
        On Error GoTo 0
        
        If elementRow > 0 And parameterCol > 0 Then
            wsTable.Cells(elementRow, parameterCol).Value = "X"
        End If
    Next i

    Application.ScreenUpdating = True

End Sub

The issue I found:
When the parameter value is not found in the table (for example, a parameter called NotParameter), the X is filled in taking the previous valid parameter.

I attach a an image for explaining me better.
In my example, the Element 4 has 3 rows (first one is not a parameter, second is Location and third is Material). When the table is filled in, the Element 4 has Location (ok), Material (ok) and Volume (not ok, which corresponds to the previous parameter in the list (cell B11).

I guess the issue can be solved adding a line to the vba saying if parameter value is NotParameter, then leave the cell empty, but when I try it gives me an error because I don't have enough expertise in vba.

Thank you!