VBA Comparing Single List to Many Lists & Generating A Text as Result

ExcelForumHelp.jpg

Good day all and happy new year.

The data I'm dealing with is larger therefore I've simplified it to the above image. I'll do my best to explain what I would like to achieve. I've not started on the VBA codes yet as I don't know where to begin from and my level in VBA is just a beginner.

As you can see from the image attached, I'd like to have all the information in the whole of column A (taking into account that column A may expand as it depends on the data that is fed in from another sheet - thus the selection of column A has to be able to expand automatically)

and compare it with information in Column F, Column H and Column J (data in this columns are fixed and need not to be expand), on another note, Column F, H and J are in another worksheet (say "Sheet 2").

Once the comparison is done, I'd like to have the result shown in Column B indicating "Priority 1" if it is from Column F, "Priority 2" if it is from Column H and "Priority 3" if it is from Column J.

Apologies if this has been answered in another thread however I tried searching around but I couldn't find the right key words to put together to find the solution that fits.

Big thanks in advance,
Aaron

Something like this, perhaps:

Sub MultiMatch()

Const lDATA_COL As Long = 1
Const lSTART_ROW As Long = 2
Const sSEARCH_SHEET As String = "Sheet1"
Const lOUTPUT_OFFSET As Long = 1

Dim avRanges As Variant
Dim avDescription As Variant
Dim lLastRow As Long
Dim rngLoop As Range
Dim bMatched As Boolean
Dim lSearchLoop As Long
Dim vSearchResult As Variant

lLastRow = Cells(Rows.Count, lDATA_COL).End(xlUp).Row

avRanges = Array("F:F", "H:H", "J:J")
avDescription = Array("Priority 1", "Priority 2", "Priority 3")

For Each rngLoop In Range(Cells(lSTART_ROW, lDATA_COL), Cells(lLastRow, lDATA_COL)).Cells
  If Not rngLoop.Value = "" Then
    
    bMatched = False
    lSearchLoop = LBound(avRanges)
    
    While Not bMatched And lSearchLoop <= UBound(avRanges)
      vSearchResult = Application.Match(rngLoop.Value, Sheets(sSEARCH_SHEET).Range(avRanges(lSearchLoop)), 0)
      
      If Not IsError(vSearchResult) Then
        bMatched = True
      Else
        lSearchLoop = lSearchLoop + 1
      End If
    Wend
    
    If bMatched Then
      rngLoop.Offset(0, lOUTPUT_OFFSET).Value = avDescription(lSearchLoop)
    End If
  End If
Next rngLoop


End Sub

Thanks for the swift reply ! this works very well !

However, what if data in column F, H and J are in another sheet like Sheet 2. What modifications to the code that I need to make so that it compares between Column A in sheet 1 and F, H and J in sheet 2 ? I could only understand some of the codes, unsure if what I've just asked has already been written in the code above.

This line of the code tells it which sheet to search:

Const sSEARCH_SHEET As String = "Sheet1"

So if you changed that line to:

Const sSEARCH_SHEET As String = "Sheet2"

It would search the sheet named "Sheet2".

I've changed the code to add a new line (in bold) which specifies the source sheet:

Sub MultiMatch()

Const lDATA_COL As Long = 1
Const lSTART_ROW As Long = 2
Const sSEARCH_SHEET As String = "Sheet1"
Const sSOURCE_SHEET As String = "Sheet1"
Const lOUTPUT_OFFSET As Long = 1

Dim avRanges As Variant
Dim avDescription As Variant
Dim lLastRow As Long
Dim rngLoop As Range
Dim bMatched As Boolean
Dim lSearchLoop As Long
Dim vSearchResult As Variant

avRanges = Array("F:F", "H:H", "J:J")
avDescription = Array("Priority 1", "Priority 2", "Priority 3")

With Sheets(sSOURCE_SHEET)

  lLastRow = Cells(Rows.Count, lDATA_COL).End(xlUp).Row


  For Each rngLoop In .Range(.Cells(lSTART_ROW, lDATA_COL), .Cells(lLastRow, lDATA_COL)).Cells
    If Not rngLoop.Value = "" Then
    
      bMatched = False
      lSearchLoop = LBound(avRanges)
    
      While Not bMatched And lSearchLoop <= UBound(avRanges)
        vSearchResult = Application.Match(rngLoop.Value, Sheets(sSEARCH_SHEET).Range(avRanges(lSearchLoop)), 0)
      
        If Not IsError(vSearchResult) Then
          bMatched = True
        Else
          lSearchLoop = lSearchLoop + 1
        End If
      Wend
    
      If bMatched Then
        rngLoop.Offset(0, lOUTPUT_OFFSET).Value = avDescription(lSearchLoop)
      End If
    End If
  Next rngLoop
End With

End Sub

The first proper line of code specifies the column that the data being searched for is in, so:

Const lDATA_COL As Long = 1

1 = Column A, if you wanted your source data to be in column C you'd change that line to:

Const lDATA_COL As Long = 3

The code also automatically finds the last row in the data column containing data and loop down to there, so it will work with any number of entries in the specified data column.

Whoops, missed a bit. This line of code:

lLastRow = Cells(Rows.Count, lDATA_COL).End(xlUp).Row

Needs to be changed to:

lLastRow = .Cells(.Rows.Count, lDATA_COL).End(xlUp).Row

A small, but important point.

Thanks ! I'm trying them out now

Really easy. This little bit of code towards the end:

If bMatched Then
  rngLoop.Offset(0, lOUTPUT_OFFSET).Value = avDescription(lSearchLoop)
End If

Just needs to be changed to:

If bMatched Then
  rngLoop.Offset(0, lOUTPUT_OFFSET).Value = avDescription(lSearchLoop)
Else
  rngLoop.Offset(0, lOUTPUT_OFFSET).Value = "No_Priority"
End If

And that should be it.

Thanks ! Everything works great now !

Thanks so much for your help ! Definitely learnt something new here