VBA Loop Copy & Vertical Paste 2 data points based on [3rd] Criteria

mst3kr

New Member
Joined
Apr 15, 2013
Messages
28
I have some data that I need to flip and copy & paste vertically based on the value at the intersection of a row & column. Below is the data as it is currently & how I need it to look. The result is based on where the policy is marked as 'Required' for that job & policy. I have tried various, inelegant formula options, and some VBA but cannot get either to work. I need it to loop through roughly 400 rows and 125 columns. I've looked thru the forums to see if something similar was asked/posted but came up empty. So, any help would be greatly appreciated!


Current:
A1 B1 C1 D1
JobPolicy 1Policy 2Policy 3
Electrician-JourneymanRequiredRequiredRequired
Facilities MaintenanceRequiredRequiredRequired
Maintenance ManagerRequiredRequiredRequired
QA ManagerN/ARequiredN/A
Warehouse ManagerN/AN/ARequired

<tbody>
</tbody>


Result:
Policy 1Electrician-Journeyman
Policy 1Facilities Maintenance
Policy 1Maintenance Manager
Policy 2Electrician-Journeyman
Policy 2Facilities Maintenance
Policy 2Maintenance Manager
Policy 2QA Manager
Policy 3Electrician-Journeyman
Policy 3Facilities Maintenance
Policy 3Maintenance Manager
Policy 3Warehouse Manager


<tbody>
</tbody>
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this for results on sheet2.
Code:
[COLOR="Navy"]Sub[/COLOR] MG26Jun08
[COLOR="Navy"]Dim[/COLOR] ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
ray = Cells(1).CurrentRegion
ReDim nray(1 To UBound(ray, 1) * UBound(ray, 2), 1 To 2)
nray(1, 1) = "Policy#": nray(1, 2) = "Job"
c = 1
[COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(ray, 2)
    [COLOR="Navy"]For[/COLOR] n = 2 To UBound(ray, 1)
       [COLOR="Navy"]If[/COLOR] ray(n, Ac) = "Required" [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        nray(c, 1) = ray(1, Ac)
        nray(c, 2) = ray(n, 1)
       [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 2)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

mst3kr

New Member
Joined
Apr 15, 2013
Messages
28
Thanks so much Mick! This works perfectly!! I've never worked with UBound commands before. I guess I have another bit of VBA code to get to know... :)
 

mst3kr

New Member
Joined
Apr 15, 2013
Messages
28
Hi Mick. I have an additional question. I have been asked to actually to include the verbiage "Required" or "N/A", where the criteria intersect, in my final output. Thus, the data would look like:

Policy 1 Electrician-Journeyman Required
Policy 3 QA Manager N/A

I've tried to manipulate the code by adding an additional nray and/or adding an additional IF statement to include the 3rd criteria but haven't been able to get it to work. How can I change the coding to copy & paste that 3rd criteria?
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
This code now returns the string in the intersecting cells (column 3 sheet2) rather than based on the word "Required".
Code:
[COLOR="Navy"]Sub[/COLOR] MG27Jun31
[COLOR="Navy"]Dim[/COLOR] ray [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
ray = Cells(1).CurrentRegion
ReDim nray(1 To UBound(ray, 1) * UBound(ray, 2), 1 To 3)
nray(1, 1) = "Policy#": nray(1, 2) = "Job": nray(1, 3) = "Criteria"
c = 1
[COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(ray, 2)
    [COLOR="Navy"]For[/COLOR] n = 2 To UBound(ray, 1)
        c = c + 1
        nray(c, 1) = ray(1, Ac)
        nray(c, 2) = ray(n, 1)
        nray(c, 3) = ray(n, Ac)
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, 3)
    .Value = nray
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

mst3kr

New Member
Joined
Apr 15, 2013
Messages
28
Works perfectly! Thanks Mick! When I'd tried revising the code, it matched yours except for the third nray components, (ray(N, Ac). I kept thinking it needed to be either n, 2 or n, 3. VBA has never been my strong suit but over the years I've learned quite a bit but clearly have more to go! Thanks again! :)
 

Forum statistics

Threads
1,082,359
Messages
5,364,919
Members
400,815
Latest member
Joaquin Phoenix

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top