Hello coders and VBA gurus,
Your help is much appreciated and urgently requested about the below.
I have the following piece of code which did the job I want to do on another dataset. Unfortunately I do not have the original dataset.
What I think this program is supposed to do roughly is:
= Find the closest matching pair of companies from two datasets/worksheets
= According to firstly SIZE (Asset)
= Then INDUSTRY (as represented by the 'SIC' code)
= Then other variables (as desired) - in my sample case the variables I want to match on are: a001000000(size); incd (industry code); roa mbr; dar in that order
= So that you are left with a dataset with a sample of the firms from each of the two original datasets, in pairs, so that they are closely matched in terms of all but the separating variable that separates the two datasets (i.e. in the case below "Chinese" or "US")
How can I implement the code provided to do as above but using my sample, for example?
I include a sample of my own data. My problem is what do I need to change in the code (or my own dataset) in order to be able to run this program using my own dataset.
Here is the code:
</code>
The worksheets I have look like the following:
Worksheet 1 (CHINA)
Company ID; Company Size; Company Returns; Other variables
(total about 50 rows each variable)
Worksheet 2 (US)
Company ID; Company Size; Company Returns; Other variables
(total about 200 rows each variable)
How do I interpret/change the code so that the VBA runs on my new worksheets? Do I need to change column headings, or name ranges? What about the numbers, for example "SIC" ID - "IND" or "INDFIRM" in the code - is only 1 digit and not three. Struggling with this VBA and how it runs on the detail, what I need to change in it, and in my worksheets.
NB This is a cross-posting from here:
http://www.excelforum.com/excel-pro...s-from-2-datasets-based-on-size-industry.html because I got no response on that forum and moving incredibly fast down the pages.
Your help is much appreciated and urgently requested about the below.
I have the following piece of code which did the job I want to do on another dataset. Unfortunately I do not have the original dataset.
What I think this program is supposed to do roughly is:
= Find the closest matching pair of companies from two datasets/worksheets
= According to firstly SIZE (Asset)
= Then INDUSTRY (as represented by the 'SIC' code)
= Then other variables (as desired) - in my sample case the variables I want to match on are: a001000000(size); incd (industry code); roa mbr; dar in that order
= So that you are left with a dataset with a sample of the firms from each of the two original datasets, in pairs, so that they are closely matched in terms of all but the separating variable that separates the two datasets (i.e. in the case below "Chinese" or "US")
How can I implement the code provided to do as above but using my sample, for example?
I include a sample of my own data. My problem is what do I need to change in the code (or my own dataset) in order to be able to run this program using my own dataset.
Here is the code:
Code:
<code>distance = 0.1 * Abs(us1 / chi1 - 1) + 0.9 * Abs(us2 / chi2 - 1) End Function Sub DAMatch() 'Asset+ROA 3 digits Dim i, j, k, l, m, t, Num As Integer Dim n As Integer n = 3 Dim ind As String ReDim ChPrio(0, 0, 3) As Variant ReDim Chfirm(20, 0) As Variant ReDim Indfirm(20, 0) As Variant 'We must rank the data by sic and cik first !!!! Worksheets("China").Activate Columns("W:CD").Select Selection.ClearContents For i = 2 To 211 Worksheets("China").Activate ReDim Chfirm(20, 0) As Variant ReDim Indfirm(20, 0) As Variant ind = Left(Cells(i, 3), 2) Do While Left(Cells(i, 3), 2) = ind ReDim Preserve Chfirm(20, UBound(Chfirm, 2) + 1) For k = 1 To 20 Chfirm(k, UBound(Chfirm, 2)) = Cells(i, k) Next k i = i + 1 Loop i = i - 1 Worksheets("US").Activate j = 2 ' us firms Do While Left(Cells(j, 3), 2) <> ind And Cells(j, 3) <> "" 'find the first firm in this industry j = j + 1 Loop If Left(Cells(j, 3), 2) = ind Then Do While Left(Cells(j, 3), 2) = ind If Cells(j, 4) <> "" And Cells(j, 6) <> "" Then 'the distance can be calculated ReDim Preserve Indfirm(20, UBound(Indfirm, 2) + 1) For k = 1 To 20 Indfirm(k, UBound(Indfirm, 2)) = Cells(j, k) Next k End If j = j + 1 Loop End If Worksheets("China").Activate ReDim ChPrio(UBound(Chfirm, 2), UBound(Indfirm, 2), 3) As Variant For j = 1 To UBound(Chfirm, 2) ChPrio(j, 0, 1) = Chfirm(1, j) 'label of CHN firms If Chfirm(4, j) <> "" And Chfirm(6, j) <> "" Then 'distance can be calculated For k = 1 To UBound(Indfirm, 2) 'If Indfirm(4, k) <> "" And Indfirm(6, k) <> "" Then ChPrio(j, k, 1) = Indfirm(1, k) ChPrio(j, k, 2) = distance(Chfirm(4, j), Chfirm(6, j), Indfirm(4, k), Indfirm(6, k)) ChPrio(j, k, 3) = k 'End If Next k End If Next j For j = 1 To UBound(Chfirm, 2) 'rank the matching firms ReDim temp(1, 3) As Variant For k = 1 To UBound(ChPrio, 2) - 1 'mao pao For m = k + 1 To UBound(ChPrio, 2) If ChPrio(j, m, 2) < ChPrio(j, k, 2) Then temp(1, 1) = ChPrio(j, k, 1) temp(1, 2) = ChPrio(j, k, 2) temp(1, 3) = ChPrio(j, k, 3) ChPrio(j, k, 1) = ChPrio(j, m, 1) ChPrio(j, k, 2) = ChPrio(j, m, 2) ChPrio(j, k, 3) = ChPrio(j, m, 3) ChPrio(j, m, 1) = temp(1, 1) ChPrio(j, m, 2) = temp(1, 2) ChPrio(j, m, 3) = temp(1, 3) End If Next m Next k Next j ReDim Chtemp(UBound(Chfirm, 2), n, 3) As Variant ReDim Indtemp(UBound(Indfirm, 2), 3) As Variant If UBound(ChPrio, 2) > 0 Then 'If there are available us firms For j = 1 To UBound(Chfirm, 2) If ChPrio(j, 1, 1) <> "" Then For k = 1 To n 'initialize For l = 1 To 3 Chtemp(j, k, l) = "" Next l Next k m = 1 ' the number of matching firms For k = 1 To UBound(Indfirm, 2) Num = ChPrio(j, k, 3) 'firm j's kth preference If Indtemp(Num, 2) = "" Then 'available Indtemp(Num, 1) = ChPrio(j, 0, 1) Indtemp(Num, 2) = ChPrio(j, k, 2) Indtemp(Num, 3) = j Chtemp(j, m, 1) = ChPrio(j, k, 1) Chtemp(j, m, 2) = ChPrio(j, k, 2) Chtemp(j, m, 3) = ChPrio(j, k, 3) m = m + 1 ElseIf ChPrio(j, k, 2) < Indtemp(Num, 2) And Indtemp(Num, 2) <> "" Then 'gain priority t = Indtemp(Num, 3) Indtemp(Num, 1) = ChPrio(j, 0, 1) Indtemp(Num, 2) = ChPrio(j, k, 2) Indtemp(Num, 3) = j Chtemp(j, m, 1) = ChPrio(j, k, 1) Chtemp(j, m, 2) = ChPrio(j, k, 2) Chtemp(j, m, 3) = ChPrio(j, k, 3) m = m + 1 If t < j Then 'jump back j = t - 1 Exit For End If ElseIf ChPrio(j, k, 2) = Indtemp(Num, 2) And Indtemp(Num, 2) <> "" Then ' itself Chtemp(j, m, 1) = ChPrio(j, k, 1) Chtemp(j, m, 2) = ChPrio(j, k, 2) Chtemp(j, m, 3) = ChPrio(j, k, 3) m = m + 1 End If If m > n Then Exit For 'the number is enough Next k End If Next j For j = i - UBound(Chfirm, 2) + 1 To i 'out print For k = 1 To Application.WorksheetFunction.Min(n, UBound(Indfirm, 2)) If Chtemp(j - i + UBound(Chfirm, 2), k, 3) <> "" Then 'if there is a matching firm there For t = 1 To 20 Cells(j, 22 + 20 * (k - 1) + t) = Indfirm(t, Chtemp(j - i + UBound(Chfirm, 2), k, 3)) Next t End If Next k Next j End If Next i End SubThe worksheets I have look like the following:
Worksheet 1 (CHINA)
Company ID; Company Size; Company Returns; Other variables
(total about 50 rows each variable)
Worksheet 2 (US)
Company ID; Company Size; Company Returns; Other variables
(total about 200 rows each variable)
How do I interpret/change the code so that the VBA runs on my new worksheets? Do I need to change column headings, or name ranges? What about the numbers, for example "SIC" ID - "IND" or "INDFIRM" in the code - is only 1 digit and not three. Struggling with this VBA and how it runs on the detail, what I need to change in it, and in my worksheets.
NB This is a cross-posting from here:
http://www.excelforum.com/excel-pro...s-from-2-datasets-based-on-size-industry.html because I got no response on that forum and moving incredibly fast down the pages.
Last edited:
