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,084,936
Messages
5,380,667
Members
401,695
Latest member
dwoychowski

Some videos you may like

This Week's Hot Topics

Top