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.
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
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.