VBA: Calling multiple rows from a larger table

Question

I want to insert rows from an excel table into a 'results' sheet if the values in column A of the table match a value specified by the user on the results sheet.

Firstly I would like to ask if there is a more efficient way to do this than what I have embarked on, and if not I would appreciate some help with my attempt.

I was planning on the following

1. sorting the data table by column A so that if new items have been added they appear in alphabetical order
2. Using WorksheetFunction.CountIf to determine the number of rows matching the criteria & setting this as a variable
3. Using WorksheetFunction.Match to find the first matching Row & setting this value as a variable

4. using established variables to copy the relevant values over to the results tab

   Sub CheckPrevious()
       Dim RowCount As Integer
       Dim FirstRow As Integer
       Dim Rng As Range
       Dim MatchRng As Range
       Dim MatchItem As Variant
   
       Rng = Sheets("Database").Range("A1:P200")
       MatchRng = Sheets("Database").Range("A1:A200")
       MatchItem = Sheets("Menu").Range("C9")
       RowCount = WorksheetFunction.CountIf(Worksheets("Database").Range("A:A"), _
       Worksheets("Menu").Range("C9").Value)
       FirstRow = WorksheetFunction.Match(MatchRng, MatchItem, 0)
   
   Sheets("Pricing").Range("A2:E6").ClearContents
   
   Worksheets("Database").AutoFilter.Sort.SortFields.Clear
   Worksheets("Database").AutoFilter.Sort.SortFields.Add Key:= _
       Range("A1:A7"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
       xlSortNormal
   With ActiveWorkbook.Worksheets("Database").AutoFilter.Sort
       .Header = xlYes
       .MatchCase = False
       .Orientation = xlTopToBottom
       .SortMethod = xlPinYin
       .Apply
   End With
   
   
   If RowCount > 1 Then
       Sheets("Pricing").Range("A2").Value = Worksheets("Database").Range("A" & FirstRow).Value
       Sheets("Pricing").Range("B2").Value = Worksheets("Database").Range("B" & FirstRow).Value
       Sheets("Pricing").Range("C2").Value = Worksheets("Database").Range("C" & FirstRow).Value
       Sheets("Pricing").Range("D2").Value = Worksheets("Database").Range("D" & FirstRow).Value
       Sheets("Pricing").Range("E2").Value = Worksheets("Database").Range("E" & FirstRow).Value
       FirstRow = FirstRow + 1
   End If
   
   If RowCount > 2 Then
       Sheets("Pricing").Range("A3").Value = Worksheets("Database").Range("A" & FirstRow).Value
       Sheets("Pricing").Range("B3").Value = Worksheets("Database").Range("B" & FirstRow).Value
       Sheets("Pricing").Range("C3").Value = Worksheets("Database").Range("C" & FirstRow).Value
       Sheets("Pricing").Range("D3").Value = Worksheets("Database").Range("D" & FirstRow).Value
       Sheets("Pricing").Range("E3").Value = Worksheets("Database").Range("E" & FirstRow).Value
       FirstRow = FirstRow + 1
   End If
   
   If RowCount > 3 Then
       Sheets("Pricing").Range("A4").Value = Worksheets("Database").Range("A" & FirstRow).Value
       Sheets("Pricing").Range("B4").Value = Worksheets("Database").Range("B" & FirstRow).Value
       Sheets("Pricing").Range("C4").Value = Worksheets("Database").Range("C" & FirstRow).Value
       Sheets("Pricing").Range("D4").Value = Worksheets("Database").Range("D" & FirstRow).Value
       Sheets("Pricing").Range("E4").Value = Worksheets("Database").Range("E" & FirstRow).Value
       FirstRow = FirstRow + 1
   End If
   
   If RowCount > 4 Then
       Sheets("Pricing").Range("A5").Value = Worksheets("Database").Range("A" & FirstRow).Value
       Sheets("Pricing").Range("B5").Value = Worksheets("Database").Range("B" & FirstRow).Value
       Sheets("Pricing").Range("C5").Value = Worksheets("Database").Range("C" & FirstRow).Value
       Sheets("Pricing").Range("D5").Value = Worksheets("Database").Range("D" & FirstRow).Value
       Sheets("Pricing").Range("E5").Value = Worksheets("Database").Range("E" & FirstRow).Value
       FirstRow = FirstRow + 1
   End If
   
   
   End Sub
   

Am currently getting a type mismatch error on my WorksheetFunction.Match

Thanks in advance for any help!

Answer 1

Looks like you have got the order of MATCH's arguments mixed up, the first argument should be the value you're looking for while the second should be the range you search over. You have them the other way round.

In response to your request, I've edited your code a bit to make it more compact:

Sub CheckPrevious()
    Dim RowCount As Long
    Dim FirstRow As Long
    Dim RowOffset As Long
    Dim ColumnOffset As Long
    Dim Rng As Range
    Dim MatchRng As Range
    Dim MatchItem As String

    Set Rng = ThisWorkbook.Worksheets("Database").Range("A1:P200")
    Set MatchRng = ThisWorkbook.Worksheets("Database").Range("A1:A200")
    MatchItem = ThisWorkbook.Worksheets("Menu").Range("C9")
    RowCount = Application.WorksheetFunction.CountIf(Worksheets("Database").Range("A:A"), MatchItem)
    FirstRow = Application.WorksheetFunction.Match(MatchItem, MatchRng, 0)

    ThisWorkbook.Worksheets("Pricing").Range("A2:E6").ClearContents

    With ThisWorkbook.Worksheets("Database").AutoFilter.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1:A11"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


    For RowOffset = 0 To RowCount - 1
        For ColumnOffset = 0 To 4
            ThisWorkbook.Worksheets("Pricing").Range("A2").Offset(RowOffset, ColumnOffset).Value2 _
                    = ThisWorkbook.Worksheets("Database").Range("A" & FirstRow).Offset(RowOffset, ColumnOffset).Value2
        Next ColumnOffset
    Next RowOffset
End Sub

I won't go into all the details on how it works now, but I'll say that the main improvement over what you had written is the outer for-loop which completely eliminates the if-statements you had in your code.

I was a bit uncertain about whether or not the inner for-loop was necessary, as it decreases readability quite a bit, but decided on leaving it in, if for no other reason than to demonstrate further how to use OFFSET to refer to cells.

You should also notice that if C9 in the Menu-sheet is left blank, there is a good chance your code will crash - so maybe add in a check for that.

In conclusion I won't say that this is exactly how I'd have solved your task if I was the one to create a solution in the first place, but hopefully my editing of your code will give you some insight into a somewhat different approach to the problem.

This was what the three sheets I copied into my workbook looked like after I attempted running the code: