vba code help needed

[lwarren1968]

I've been working on a project that involves combining Power Query with some VBA scripting, and I've hit a bit of a roadblock that i hope someone can help me with.

Here's what I've done so for:

• I have a main table in the "QRY" sheet.
• Column K [VALUE 1] in the table has a dropdown list that matches the values in column I [Product Category] with the values in column A [cat] from the VALUE ! sheet.
• The dropdown in column K should return the corresponding detail from column B [DROP DOWN} as a list

Where I'm stuck:

• • I need to add to my VBA or adjust the VBA code that will automatically:
  • Combined the contents of column I [Product Category] and column K [VALUE 1] in the QRY sheet (with no spaces)
    • Match this combined result with the [CAT_SUB] column in the ATTRIBUTES sheet
    • Return columns F through P [Label 1], [Label 2]. etc. from the ATTRIBUTES sheet to the QRY sheet, starting at column L
    • Insert a blank column after each returned column, as these columns are already named.

I just can't get thispart to work, and any guidence would be greatly appreciated.

Thanks in advance for you help.

 

[raziel3]

All this can be done with power query. VBA may not be needed.

 

[jdelano]

I added this to handle what you are looking for

Dim writingToWorksheet As Boolean  ' flag to skip executing this event if the K or I column is doing the changing

Private Sub Worksheet_Change(ByVal Target As Range)

    If writingToWorksheet Then Exit Sub

    ' Check if the change was made in column I (Product Category)
    Select Case Target.Column
        Case 9
            UpdateColumK Target
        
        Case 11
            ReactToColumK Target
    End Select

    writingToWorksheet = False
    
End Sub

Private Sub ReactToColumK(Target As Range)

    ' if either col K or I are blank then exit
    If Len(Target.Value) = 0 Or Len(Target.Offset(, -2).Value) = 0 Then Exit Sub
    
    writingToWorksheet = True  ' flag to tell the change event to ignore any changes
    
    Dim combinedValue As String
    Dim attWS As Worksheet
    Dim catSubRange As Range
    Dim findAttRange As Range
    
    Set attWS = ThisWorkbook.Sheets("Attributes")
    Set catSubRange = attWS.Range("E:E")
    
    ' combine the values contained in column I and K
    combinedValue = Target.Offset(, -2).Value & Target.Value
    
    On Error Resume Next
    Set findAttRange = catSubRange.Find(combinedValue, LookIn:=xlValues)
    
    If findAttRange Is Nothing Then
        ' the value could not be found - tell the user
        Target.Offset(, 1).Value = "No Match"
    Else
        ' pull the data from attributes sheet
        Dim attCell As Range
        Dim cellOffSet As Integer
        
        cellOffSet = 1 ' this will increment the cell on QRY
        For Each attCell In attWS.Range("F" & findAttRange.Row & ":P" & findAttRange.Row).Cells
            
            Target.Offset(, cellOffSet).Value = attCell.Value
            cellOffSet = cellOffSet + 2   ' skip a column while bringing the data over
        Next attCell
        
    End If
    
    Set findAttRange = Nothing
    Set attWS = Nothing
    Set catSubRange = Nothing
    
End Sub

Private Sub UpdateColumK(Target As Range)

    ' fill the dropdown contained in the K column
    Dim wsValue1 As Worksheet
    Dim dropDownItems As String
    Dim itemArray() As String
    Dim catValue As Variant
    
    ' Ensure Target is a single cell
    If Target.Cells.Count > 1 Then Exit Sub
    
    ' Ensure that the target cell is not empty and is not an error
    If IsEmpty(Target.Value) Or IsError(Target.Value) Then Exit Sub
    
    ' Get the matching cat value
    catValue = Target.Value
    
    ' Ensure catValue is a string
    If VarType(catValue) <> vbString And VarType(catValue) <> vbDouble Then Exit Sub

    ' Set the VALUE 1 sheet
    Set wsValue1 = ThisWorkbook.Sheets("VALUE 1")
    
    ' Find the matching DROP DOWN items
    On Error Resume Next
    dropDownItems = Application.WorksheetFunction.VLookup(catValue, wsValue1.Range("A:B"), 2, False)
    On Error GoTo 0
    
    writingToWorksheet = True
    
    If dropDownItems <> "" Then
        ' Split the comma-separated list into an array
        itemArray = Split(dropDownItems, ",")
        
        ' Add dropdown to the corresponding cell in column K
        With Me.Cells(Target.Row, "K").Validation
            .Delete ' Remove any existing validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, Formula1:=Join(itemArray, ",")
            .IgnoreBlank = True
            .InCellDropdown = True
            .ShowInput = True
            .ShowError = True
        End With
    Else
        ' If no match found, clear the validation
        Me.Cells(Target.Row, "K").Validation.Delete
    End If

End Sub