Pull values into one cell based on multiple criteria

44 views Asked by At

trying to run a VBA that returns different cell values from a worksheet into another worksheet signle cell based on multiple criteria that matches (smth close to textjoin/filter function)

here is a code I was trying to run

Sub FindValues()

Dim lookUpSheet As Worksheet, updateSheet As Worksheet
Dim valueToSearch As String
Dim i As Long

Set lookUpSheet = Worksheets("Test")
Set updateSheet = Worksheets("result")

Worksheets("result").Cells(22, 5).Value = result
    
For i = 2 To lastRow
        If lookUpSheet.Cells(i, 5).Value & lookUpSheet.Cells(i, 2).Value = updateSheet.Range("C22").Value & updateSheet.Range("E21").Value Then
            Worksheets("result").Cells(22, 5).Value = lookUpSheet.Cells(i, 1).Value & vbNewLine & lookUpSheet.Cells(i, 3).Value & vbNewLine & lookUpSheet.Cells(i, 4).Value & vbNewLine
        End If
    Next i
    
   
End Sub
1

There are 1 answers

0
taller On BEST ANSWER

Please try.

Option Explicit
Sub FindValues()
    Dim lookUpSheet As Worksheet, updateSheet As Worksheet
    Dim i As Long, lastRow as Long
    Dim sResult As String, sKey As String
    Set lookUpSheet = Worksheets("Test")
    Set updateSheet = Worksheets("Result")
    sKey = updateSheet.Range("C22").Value & updateSheet.Range("E21").Value
    with lookUpSheet
        lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row ' modify column # as needed
        For i = 2 To lastRow
            If .Cells(i, 5).Value & .Cells(i, 2).Value = sKey Then
                sResult = sResult & vbNewLine &  .Cells(i, 1).Value & vbNewLine _
                    & .Cells(i, 3).Value & vbNewLine & .Cells(i, 4).Value
            End If
        Next i
    end with
    updateSheet.Cells(22, 5).Value = mid(sResult,2)
End Sub