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

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

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!

What is in C9 on the Menu-sheet? The customer name?

eirikdaude
– eirikdaude

2016-03-09 10:23:41 +00:00
Commented Mar 9, 2016 at 10:23 — eirikdaude
– eirikdaude, Commented Mar 9, 2016 at 10:23

eirikdaude · Accepted Answer · 2016-03-09 10:54:33Z

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:

edited Mar 9, 2016 at 10:54

answered Mar 9, 2016 at 9:40

eirikdaude

3,2606 gold badges29 silver badges58 bronze badges

Sign up to request clarification or add additional context in comments.

5 Comments

F.A.H. Over a year ago

Wow, feel like an idiot now! Thanks. Though I'm now getting a 'Object Required' error on the Set RowCount line; any ideas?

F.A.H. Over a year ago

It's all working fine except that it returns one less of the rows than exist in the data table. If there are five it should return, only four appear in the results tab. Any ideas?

eirikdaude Over a year ago

@F.A.H. Could you link to some sample data, post it to google sheets or something? It'd be much simpler to troubleshoot your code with some sample data to work with.

F.A.H. Over a year ago

Sure, here is the format of it at the moment; the final thing will have a few hundred rows and ~3 more columns of actual data, but that will be easy to alter. Thanks again.

F.A.H. Over a year ago

Ah fixed it; the issue was starting the If RowCount > 1 statements at 1, rather than zero. Which makes a lot of sense; another silly error. Thanks, for your help!

Collectives™ on Stack Overflow

VBA: Calling multiple rows from a larger table

1 Answer 1

5 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

5 Comments

Your Answer

Sign up or log in

Post as a guest

Related