在VBA中跨两个子函数使用数组

Question

I'm writing a macro that compares two columns of data and then identifies the rows where there is duplicate data found across both columns. That part of my program works. However, I dont know how to use arrays across two separate "Subs" in VBA. It's easier to explain if you first see my code.

Function DuplicateFinder(SheetName1 As String, SheetName2 As String)

Dim D As Object, C
Dim nda As Long, ndb As Long
Dim test As Range
Dim StorageArray(1000)
Dim increment
increment=0   

Set D = CreateObject("scripting.dictionary")
Sheets(SheetName2).Select
ndb = Range("O" & Rows.count).End(xlUp).Row
Sheets(SheetName1).Select
nda = Range("O" & Rows.count).End(xlUp).Row

For Each C In Range("O2:O" & nda)
    D(C.Value) = 1
    C.Select
Next C

Sheets(SheetName2).Select
For Each C In Range("O2:O" & ndb)
    If D(C.Value) = 1 Then
        C.Select

        StorageArray(increment) = C.Value ' this is where i want to store the C value.
    End If
    If Len(C) = 0 Then
        C.Interior.Color = vbRed
        MsgBox "Macro terminated at the blank red cell," & Chr(10) & _
            "as per instructions"

    End If
Next C

End Function

Sub MainFunction()

Dim A As String
Dim B As String
Dim C As String
Dim D As String

A = "Sheet 1 Name"
B = "Sheet 2 Name"
C = "Sheet 3 Name"
D = "Sheet 4 Name"
increment = 0


Call DuplicateFinder(Sheet 1 Name, Sheet 2 Name)
'I would then call the function 5 more times to compare each column in each sheet to one another

End Sub

The first function is used to compare the data across column '1' and column '2', and then identify the cells where there is duplicate data across each column. Again, that part works. The second sub is just the main function used to run the code. What I want to do, and don't know how to, is every time the DuplicateFinder finds a duplicate, it saves that 'data' in an array. However, I need to run the DuplicateFinder Function 6 times to compare the data across each sheet in my workbook. For example, if the sheets name's were A, B, C, and D. I need to run the function that compares A to B, A to C, A to D, B to C, B to D, and finally C to D. However, the data saved in the array is only available in the DuplicateFinder Function.

I was thinking maybe the solution was to have the function return the value, but I don't understand how that works. I would appreciate anyone's input.

Answer 1

You can return an array from a function by using this notation as function return type:

Public Function MyFunction(param1 As String, param2 As String) As String()

For example:

---

Option Explicit

Sub MainFunction()

    Const WS_NAMES As String = "Sheet1, Sheet2, Sheet3"

    Dim ws() As String, dups() As Variant, i As Integer, totalWS As Long

    ws = Split(WS_NAMES, ", ")
    totalWS = UBound(ws)
    ReDim dups(totalWS)

    dups(0) = DuplicateFinder(ws(0), ws(1))
    dups(1) = DuplicateFinder(ws(0), ws(2))
    dups(2) = DuplicateFinder(ws(1), ws(2))

    MsgBox dups(0)(1)
    MsgBox dups(1)(1)
    MsgBox dups(2)(0)

End Sub

Function DuplicateFinder(SheetName1 As String, SheetName2 As String) As String()

    Dim StorageArray(1) As String

    StorageArray(0) = SheetName1
    StorageArray(1) = SheetName2

    DuplicateFinder = StorageArray

End Function

---

Answer 2

You can avoid passing the array by using a module-level variable.

Private Duplicates() As String
Private NumDups As Long

Sub MainFunction()

Dim A As String
Dim B As String
Dim C As String
Dim D As String

A = "Sheet 1 Name"
B = "Sheet 2 Name"
C = "Sheet 3 Name"
D = "Sheet 4 Name"

NumDups = 0
ReDim Duplicates(NumDups)

Call DuplicateFinder(A, B)
Call DuplicateFinder(A, C)
Call DuplicateFinder(A, D)
Call DuplicateFinder(B, C)
Call DuplicateFinder(B, D)
Call DuplicateFinder(C, D)

End Sub

Function DuplicateFinder(SheetName1 As String, SheetName2 As String)

Dim D As Object
Dim C As Range
Dim nda As Long, ndb As Long

Set D = CreateObject("scripting.dictionary")
Sheets(SheetName2).Select
ndb = Range("O" & Rows.Count).End(xlUp).Row
Sheets(SheetName1).Select
nda = Range("O" & Rows.Count).End(xlUp).Row

For Each C In Range("O2:O" & nda)
    D(C.Value) = 1
Next C

Sheets(SheetName2).Select
For Each C In Range("O2:O" & ndb)
    If D(C.Value) = 1 Then
        NumDups = NumDups + 1
        ReDim Preserve Duplicates(NumDups)
        Duplicates(NumDups - 1) = C.Value
    End If
    If Len(C.Value) = 0 Then
        C.Interior.Color = vbRed
        MsgBox "Macro terminated at the blank red cell," & Chr(10) & _
            "as per instructions"
    End If
Next C

End Function