Code:
Option Explicit
Sub Arrays1() ' https://excelfox.com/forum/showthread.php/2667-VLOOKUP-on-Matching-Multiple-Criteria
Rem 0 Worksheets info
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = ThisWorkbook.Worksheets("Export1") ' CHANGE TO SUIT
Set Ws2 = ThisWorkbook.Worksheets("ResultVBA") ' CHANGE TO SUIT
Dim Lr1 As Long, Lr2 As Long ' For last row of data and for last row of Output range https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row: Lr2 = Ws2.Range("A" & Ws2.Rows.Count).End(xlUp).Row
Rem 1 Make or get our arrays
' get arrays
Dim SalesAmt1() As Variant, Cost1() As Variant ' for data from the input ( Sheet1 / Export LookUp table, or whatever its referred to …. In the macro: ' CHANGE TO SUIT ).
Dim SalesAmt2() As Variant, Cost2() As Variant ' for the output ( Result, Sheet 2 or whatever the output Worksheet is referred to …. In the macro : ' CHANGE TO SUIT ) , and gets filled by the macro
Dim SMTD1() As Variant, SMTD2() As Variant ' For both worksheets, I take in a 3 column array for columns Sales Man Territory Dimension which I then use to make a single column array of the concatenated values. SM_T_D1() SM_T_D2()
' ' I needs to have Dim arr() As Variant because: Variant type, because the next code lines .Value property returns a field of elements which are housed in elements of Variant type , so the type must be Variant regardles of what types are withing the elements or we will get type mismatch errors , and I need a dynamic ( not yet specified size ) array, as the working of the :Value property is such that it sends infomation to size the thing taking it: If we have a fixed size array as in then Excel will error becuse Excel will insist on wanting to do this sizing of any recieving array, which it can't do if the array is fixed size.
'1a) get some arrays
Let SalesAmt1() = Ws1.Range("D1:D" & Lr1 & "").Value: Cost1() = Ws1.Range("E1:E" & Lr1 & "").Value
Let SalesAmt2() = Ws2.Range("D1:D" & Lr2 & "").Value: Cost2() = Ws2.Range("E1:E" & Lr2 & "").Value ' This will conveniantly size our array and put the Header in
Let SMTD1() = Ws1.Range("A1:C" & Lr1 & "").Value ' The data to be searched in for a match
Let SMTD2() = Ws2.Range("A1:C" & Lr2 & "").Value ' The data to be searched in to find a match
'1b) make the two arrays for our concatenated values
Dim SM_T_D1() As String, SM_T_D2() As String ' For single column array of the concatenated values. I know the size, so does not neet to be dynamic but unfortunately I must make the array dynamic initially since Dim will only take numbers, and i want to give the "row" size from the known dimension of the previous arrays. The ReDim statement allows me givee a variable when sizing an array I will be filling these arrays in a loop, so i can choose whatever type I want
ReDim SM_T_D1(1 To Lr1): ReDim SM_T_D2(1 To Lr2)
Dim Cnt As Long ', arrRw() As Variant, ConcatStr As String
For Cnt = 1 To Lr1 ' '1b)(i) For the input data range
' Let arrRw() = Application.Index(SMTD1(), Cnt, 0) ' This picks the row out, https://usefulgyaan.wordpress.com/2013/06/12/vba-trick-of-the-week-slicing-an-array-without-loop-application-index/ , and it returns a 1D array : https://www.excelforum.com/showthread.php?t=758402&p=5408376#post5408376 '
' Let ConcatStr = Join(arrRw(), " ") ' This joins the elements of that row array making a single string from it
' Let SM_T_D1(Cnt) = ConcatStr
Let SM_T_D1(Cnt) = Join(Application.Index(SMTD1(), Cnt, 0), " ") ' Simplifying the above commented out 3 steps
Next Cnt
For Cnt = 1 To Lr2 ' '1b)(ii) For the output data range
Let SM_T_D2(Cnt) = Join(Application.Index(SMTD2(), Cnt, 0), " ")
Next Cnt
' Let Ws2.Range("G1:G8").Value = Application.Transpose(SM_T_D1()): Ws2.Range("N1:N33").Value = Application.Transpose(SM_T_D2()) ' Just For demo
Rem 2 Build Output arrays
Dim ResRw As Long
For ResRw = 2 To Lr2 ' looping down the rows of concatenated data to be Srched for in the input data for a match
Dim MtchRes As Variant ' This will be an integer of the matched position along the input data concatenated array, or a string vbError if it finds no match
Let MtchRes = Application.Match(SM_T_D2(ResRw), SM_T_D1(), 0) ' I am looking for the concatenated data of this outout data row ResRw , in the entire array of the concatenated input data SM_T_D1() , and the 0 tells Match to look for an exact match
If IsError(MtchRes) Then
' in the case of an error we had no match so we do nothing
Else
Let SalesAmt2(ResRw, 1) = SalesAmt1(MtchRes, 1)
Let Cost2(ResRw, 1) = Cost1(MtchRes, 1)
End If
Next ResRw
Rem 3 output results
Let Ws2.Range("D1:D" & Lr2 & "").Value = SalesAmt2()
Let Ws2.Range("E1:E" & Lr2 & "").Value = Cost2()
End Sub
The macro seems to work.
Originally Posted by DocAElstein
Posting Permissions
Reply With Quote
Bookmarks