Home Matching Multiple Criteria and Returning Multiple Values
Reply: 0

Matching Multiple Criteria and Returning Multiple Values

user9436 Published in September 21, 2018, 2:55 am

I have two spreadsheets (wb and wbtemp); both have a column for location and a column for feature type. In VBA, I want to find all of the rows on the second sheet where the two columns are the same as the two columns on a row in the first sheet and get a list or a range made up of the row numbers/indices.

I then want to use this range to pull out values from a different column and find the highest object in it, but I think I will probably be able to do that if I can get this range sorted.

Dim wb As Workbook
Dim ws As Worksheet
Dim Features() As Variant
Dim Activity() As Variant
Dim Benthic As Variant
Dim wbtemp As Workbook
Dim BenSenFeatures() As Variant
Dim BenSenActivity() As Variant
Dim LR As Long
Dim LC As Long
Dim r As Long
Dim c As Long
Dim WhatToFind1 As Variant
Dim WhatToFind2 As Variant
Dim rngFound1 As Range
Dim rngFound2 As Range
Dim rng1 As Variant
Dim rng2 As Variant
Dim rngFound As Range
Dim iLoop As Long
Dim colFound As Range

Set wb = ActiveWorkbook
Set ws = wb.ActiveSheet

Features = ws.Range("B:C").Value
Activity = ws.Rows(1).Value

Benthic = InputBox("Filename goes here...")
Set wbtemp = Workbooks.Open(Benthic, True, True)

With wbtemp
    BenSenFeatures = .Sheets(1).Range("A:B").Value
    BenSenActivity = .Sheets(1).Rows(1).Value
End With

LR = ws.Range("C" & Rows.Count).End(xlUp).Row
LC = ws.Cells(1, Columns.Count).End(xlToLeft).Column

For r = 3 To LR

    If Not IsEmpty(Features(r, 2)) Then
        If IsInArray(Features(r, 2), BenSenFeatures, 2) Then
        'If WorksheetFunction.Match(Features(r, 2), BenSenFeatures(0, 2), 0) Then   <---I tried to use the arrays originally
            WhatToFind1 = Features(r, 1)
            WhatToFind2 = Features(r, 2)
            Set rngFound1 = wbtemp.Sheets(1).Columns(1).Cells(wbtemp.Sheets(1).Columns(1).Cells.Count)
            Set rngFound2 = wbtemp.Sheets(1).Columns(2).Cells(wbtemp.Sheets(1).Columns(2).Cells.Count)
            For iLoop = 1 To WorksheetFunction.CountIf(wbtemp.Sheets(1).Columns(1), WhatToFind1)
                Set rngFound1 = wbtemp.Sheets(1).Columns(1).Cells.Find(WhatToFind1, After:=rngFound1)
                rng1(iLoop) = rngFound1.Row
               WorksheetFunction.Match(WhatToFind1 & WhatToFind2,_
               wbtemp.Sheets(1).Columns(1) & wbtemp.Sheets(1).Columns(2),_
               0), 1)     <---originally tried to use match to search for the multiple criteria but couldn't find a way to create a list of indices
                Set rngFound2 = wbtemp.Sheets(1).Columns(2).Cells.Find(WhatToFind2, After:=rngFound2)
                rng2(iLoop) = rngFound2.Row
            Next iLoop
            For Each cell In rng1
                If Not Application.CountIf(rng2, cell.Value) = 0 Then
                    rngFound.Cells(Cells(Rows.Count, 1).End(xlUp) + 1) = cell.Value
                End If

I originally tried to use .Match to find the multiple criteria, but I couldn't figure out how to create a range of indices from it. Then I tried using .Find to create two list of indices but I can't figure out how to get that to work. I keep getting

Type Mismatch


I realise this sounds confusing, so let me know if anything needs clarifying.

share|improve this question
  • I think you could do the matching bit at least with a COUNTIFS formula. Then you just store the row numbers in an array or a collection/dictionary. What specifically didn't work? – SJR Feb 14 at 18:49
  • @SJR Thanks for the reply. None of the bit where I'm trying to match them and make a list works but I think it's more a case of I can't figure out what to write for what I'm trying to do, rather than a specific line not working. – S.Chivers Feb 15 at 11:10

2 Answers 2

active oldest votes
up vote 0 down vote accepted
You need to login account before you can post.

About| Privacy statement| Terms of Service| Advertising| Contact us| Help| Sitemap|
Processed in 0.329297 second(s) , Gzip On .

© 2016 Powered by mzan.com design MATCHINFO