0
\$\begingroup\$

I need to get data from a spreadsheet where there are three parameters. A product ID which is multiple rows, within the rows of product ID, there is another set of rows with the charge type, within that set of rows, there is a charge I want to find, which may also span multiple rows. If the charge does span multiple rows, I take the first one.

I have a function called New_Rng which takes the sheet object, the range within the sheet to be searched, and the string to look for, and returns the range which encompasses the first and last occurrence of the search string.

I'm doing multiple calls to wind up with the value that I need, but I know it's not efficient.

This is what I have now:

dim fndRng as range
dim shtz as new workshseet
dim ctr as long

    ctr = 4

    set shtz = sheets("DATA")

    Set fndRng = shtz .range(StartRange, shtz .Cells(LastRow,LastColumn))

    If Not fndRng Is Nothing Then Set fndRng = New_Rng(shtz, fndRng, shtz.Cells(ctr, searchVal)

    If Not fndRng Is Nothing Then Set fndRng = fndRng.Offset(0, (SchCol1 - SchCol2))
    If Not fndRng Is Nothing Then Set fndRng = New_Rng(shtz, fndRng, SVal2)
    If Not fndRng Is Nothing Then Set fndRng = fndRng.Offset(0, (SchCol2 - SchCol3 ))
    If Not fndRng Is Nothing Then Set fndRng = New_Rng(shtz, fndRng, val3)
    If Not fndRng Is Nothing Then Set fndRng = fndRng.Offset(0, (SchCol3  - SchCol4))
    If Not fndRng Is Nothing Then
        For Each zell In fndRng
            If zell.Row = fndRng.Row Then LoadVar(ctr, 0) = zell.value
        Next zell
    End If

I know there's a better way, but I can't figure it out.

\$\endgroup\$
  • \$\begingroup\$ If you have the option, what I have done is add a new column to the sheet that contains the three (or more) keys that I need to search. In this case, ProductId & ChargeType & Charge. It's a good idea to put a separator (e.g. a dash) between the fields. I can then search that one column for the combination I need. \$\endgroup\$ – Rich Holton Apr 23 '17 at 6:09
  • \$\begingroup\$ @RichHolton I would love to do that, but unfortunately, I have no control over the data. \$\endgroup\$ – Don Thermidor_Lobster Mobster Apr 23 '17 at 13:19
1
\$\begingroup\$

Worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("mySheet") and instead just use mySheet. This will eliminate the shtz variable, which isn't telling us anything.

Speaking of variable names, try to give them more meaningful names - it makes it easier to follow what is happening.

Like this snippet

Sheet1.Cells(counter, searchVal))

I can tell searchVal has to be an integer, but if I saw it anywhere else, I'd think it's a string.

Also with your search columns being SchCol1 - I'm sure there's a better way to do that. Maybe productColumn and such.

I have to think your series of If Not Nothing is because you were getting errors. I also have to imagine you're passing all of these values to the above code? All the columns and all the search strings?


So, the easiest way to make this more efficient is to bring it into an array. In my example, I'm returning a string instead of a range, because I assume that's what you're after. Either way, it's an example.

Option Explicit
Sub RichardU()
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim searchValues As Variant
    Dim searchArray As Variant
    Dim foundRange As Range
    Dim startRange As Range

    lastRow = 10
    lastColumn = 4
    Set startRange = Sheet1.Cells(1, 1)

    searchValues = Sheet1.Range(Cells(1, 7), Cells(1, 10))
    searchArray = Sheet1.Range(startRange, Sheet1.Cells(lastRow, lastColumn))

    Set foundRange = FindInArray(searchArray, searchValues(1, 1), searchValues(1, 2), searchValues(1, 3))

End Sub

Function FindInArray(ByVal valueArray As Variant, ByVal firstString As String, ByVal secondString As String, ByVal thirdString As String) As String
    Dim rowIndex As Long
    With valueArray
        For rowIndex = LBound(valueArray) To UBound(valueArray)
            If valueArray(rowIndex, 1) = firstString And valueArray(rowIndex, 2) = secondString And valueArray(rowIndex, 3) = thirdString Then
                FindInArray = valueArray(rowIndex, 4)
                Exit Function
            End If
        Next
    End With
End Function

So what you're doing here is bringing the entire search range into an array, passing that array to your function and matching all of the search strings at once.

You will probably have to build in some error handling. And if you want the range instead of the string, you can still bring it all into the array and return where the range would be as a pair of coordinates

Option Explicit
Sub RichardU()
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim searchValues As Variant
    Dim searchArray As Variant
    Dim foundCoordinates As Variant
    Dim foundRange As Range
    Dim startRange As Range

    lastRow = 10
    lastColumn = 4
    Set startRange = Sheet1.Cells(1, 1)

    searchValues = Sheet1.Range(Cells(1, 7), Cells(1, 10))
    searchArray = Sheet1.Range(startRange, Sheet1.Cells(lastRow, lastColumn))

    foundCoordinates = FindInArray(searchArray, searchValues(1, 1), searchValues(1, 2), searchValues(1, 3))
    Set foundRange = Sheet1.Range(Cells(foundCoordinates(1) + 1), Cells(foundCoordinates(1) + 1, foundCoordinates(2) + 2))

End Sub

Function FindInArray(ByVal valueArray As Variant, ByVal firstString As String, ByVal secondString As String, ByVal thirdString As String) As Variant
    Dim rowIndex As Long
    Dim foundCoordinates() As Long
    ReDim foundCoordinates(1 To 2)
    With valueArray
        For rowIndex = LBound(valueArray) To UBound(valueArray)
            If valueArray(rowIndex, 1) = firstString And valueArray(rowIndex, 2) = secondString And valueArray(rowIndex, 3) = thirdString Then
                foundCoordinates(1) = rowIndex
                foundCoordinates(2) = 4
                FindInArray = foundCoordinates
                Exit Function
            End If
        Next
    End With
End Function

You'd just change the offsets I used to match your sheet layout.


So I was thinking about it, and I think the best way for you to simplify this would be to use a function to get the row index that matches -

Function FindArrayRow(ByVal valueArray As Variant, ByVal searchValues As Variant) As Long
    Dim rowIndex As Long
    With valueArray
        For rowIndex = LBound(valueArray) To UBound(valueArray)
            If valueArray(rowIndex, 1) = searchValues(0) And valueArray(rowIndex, 2) = searchValues(1) And valueArray(rowIndex, 3) = searchValues(2) Then
                FindArrayRow = rowIndex
                Exit Function
            End If
        Next
    End With
End Function

You would just return the row number in the array, adjust it for wherever your array started on the sheet, and use it to get the target column that you were initially looking for.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.