VBA：从较大的表中调用多个行

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: