Excel VBA code for multiple vlookup

Question

For a conduit network, I am trying to find the pipes that drain to a manhole. There can be multiple pipes that can drain to a single manhole. My data-structure is organized in the following way:

   Stop Node    Label
  .......................
    MH-37       CO-40
    MH-37       CO-40
    MH-39       CO-43
    MH-37       CO-44
    MH-39       CO-45
    MH-41       CO-46
    MH-35       CO-47
    MH-44       CO-50
    MH-39       CO-51
    MH-44       CO-52

and so on.

Of course, in Excel, we can workaround the multiple vlookup question using array equations. However, I am not sure how it is done in Excel VBA coding. I need to automate the whole process and hence Excel VBA coding. This task is part of a bigger assignment.

Following is the function code I wrote so far:

Function Conduitt(M As String) As String()

Dim Stop_Node As Variant /* All Manhole label */
Dim Conduit As Variant /* All conduit label */
Dim compare As Variant /* Query Manhole label */
Dim Result() As String
Dim countc As Integer

Stop_Node = ActiveSheet.Range("B2:B73").Value
Conduit = ActiveSheet.Range("C2:C73").Value
compare = M

countc = 1

Do While countc <= 72

If Application.IsError(Application.Match(Stop_Node(countc), compare)) = 0 Then

Result(countc) = Conduit(countc)

End If

countc = countc + 1

Loop

Conduitt = Result()

End Function

If you compare the sample of data I provided before, For Manhole MH-39, corresponding conduit labels are, CO-43, CO-45 and CO-51. I thought, with countc changing due to do loop, it will go through the list and find the exact matches for MH-39 and return CO-43, CO-45 and CO-51.

Objective is to return these conduit labels only as a string array with three rows (for MH-39 case).

So far, when I run the code, I get :

Run-time error '9': Subscript out of range.

I searched different forums and found it happens when non-existing array elements are referenced. At this point, my limited knowledge and experience are not helping decipher the puzzle.

After some suggestions from R3uK, got the code fixed. Apparently, when a range is assigned to a variant array (as in the case of Stop_Node and Conduit), the variant will be multi-dimensional. So, updated the code accordingly and incorporated Preserve with Redim.

İn case you are interested, the updated code:

Function Conduitt(Manhole As String) As String()

Dim Stop_Node As Variant
Dim Conduit As Variant
Dim Result() As String

ReDim Result(0)

Stop_Node = ActiveSheet.Range("B2:B73").Value
Conduit = ActiveSheet.Range("C2:C73").Value

For i = LBound(Stop_Node) To UBound(Stop_Node)
If Stop_Node(i, 1) <> Manhole Then
Else
    Result(UBound(Result)) = Conduit(i, 1)
    ReDim Preserve Result(UBound(Result) + 1)
End If
Next i
ReDim Preserve Result(UBound(Result) - 1)

Conduitt = Result

Given you want to return values in 3 rows, why are you using a function instead of a subroutine? — Raystafarian
– Raystafarian, Commented Jun 17, 2015 at 12:01
@Raystafarian : because you can have arrays as results, so it easier to have a function for it. — R3uK
– R3uK, Commented Jun 17, 2015 at 12:04
What are you trying to do with the lines Stop_Node = ActiveSheet.Range("B2:B73").Value and Conduit = ActiveSheet.Range("C2:C73").Value — gudal
– gudal, Commented Jun 17, 2015 at 12:22
@gudal In the stated code, I hit the error message once I reach the if statement. With regards to the Stop_Node and Conduit, I am copying the total list of manholes and corresponding pipes (draining to them) in the network. Objective is to find corresponding conduits of queried manhole. Thanks — İmtiaz
– İmtiaz, Commented Jun 17, 2015 at 13:43

R3uK · Accepted Answer · 2015-06-20 09:20:24Z

1

In fact, you never ReDim your Result() so it is just an empty array with no actual cell (not even an empty cell), you first need to ReDim it.

Here is my version, I didn't use the function Match but that should work anyway :

Function Conduitt(ManHole As String) As String()

Dim Stop_Node As Variant '/* All Manhole label */
Dim Conduit As Variant '/* All conduit label */
Dim Result() As String

ReDim Result(0)

Stop_Node = ActiveSheet.Range("B2:B73").Value
Conduit = ActiveSheet.Range("C2:C73").Value

For i = LBound(Stop_Node) To UBound(Stop_Node)
    If Stop_Node(i,1) <> ManHole Then
    Else
        Result(UBound(Result)) = Stop_Node(i,1)
        ReDim Preserve Result(UBound(Result) + 1)
    End If
Next i
ReDim Preserve Result(UBound(Result) - 1)

Conduitt = Result()

End Function

edited Jun 20, 2015 at 9:20

answered Jun 17, 2015 at 12:06

R3uK

14.6k8 gold badges49 silver badges81 bronze badges

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

6 Comments

İmtiaz Over a year ago

Appreciate the quick response R3uK

R3uK Over a year ago

@İmtiaz : No problem, did it fix your issue? If yes, plz validate answer (tick below up/down vote) to mark the question as solved!

İmtiaz Over a year ago

Appreciate the quick response R3uK. I am trying to get conduit label by comparing the Stop_Node label with Manhole. Therefore, I modified your proposed code a bit and it follows: For i = LBound(Stop_Node) To UBound(Stop_Node) If Stop_Node(i) <> Manhole Then Else Result(UBound(Result)) = Conduit(i) ReDim Result(UBound(Result) + 1) End If Next i ReDim Result(UBound(Result) - 1) Conduitt = Result() End Function. However, I am still getting same error once I reach 'Else'. Regards.

R3uK Over a year ago

Maybe try Dim Result() instead of Dim Result() As String, and if not enough, is the line with Else highlighted once you enter debug mode? Or is it the next one?

İmtiaz Over a year ago

with Dim Result(), I get 'Compile error: Can't assign to array' and 'Conduitt =' is highlighted (blue) in line, Conduitt = Result() ı.e. line before End Function. Then, if I click OK, the debug arrow moves back to Function Conduitt......line. Maybe, its because the function output is defined as string in the Function line? I am assuming it exits before reaching the Else line. Thanks Anyways. I'll keep on looking.

|

gudal · Accepted Answer · 2015-06-18 14:03:04Z

1

Well, see you solved it, but here is an alternative solution (had to post it now that I have worked on it)

Function ConduittCheck(manhole As String) As String()
Dim result() As String

Dim manholeRange As Range
Dim conduittRange As Range
Set manholeRange = Range("manholes")
Set conduittRange = Range("conduitts")

Dim counter As Integer
Dim size As Integer
size = 0

For counter = 0 To manholeRange.Rows.Count
    If manholeRange.Rows.Cells(counter, 1) = manhole Then
        ReDim Preserve result(size)
        result(size) = conduittRange.Rows.Cells(counter, 1)
        size = size + 1
    End If
Next counter
ConduittCheck = result()
End Function

answered Jun 18, 2015 at 14:03

gudal

3373 silver badges9 bronze badges

2 Comments

İmtiaz Over a year ago

Thanks Gudal! Appreciate the help and new approach of addressing the problem.

R3uK Over a year ago

@imtiaz : nothing really new here, same structure, just working with range instead of arrays (which will be far less efficient, as arrays are one of the key to VBA efficiency), size and counter are useless variable and furthermore counter starting at 0 will generate an error on the next line...

Collectives™ on Stack Overflow

Excel VBA code for multiple vlookup

2 Answers 2

6 Comments

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

6 Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related