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>
 

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

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! :)
 

Watch MrExcel Video

Forum statistics

Threads
1,102,728
Messages
5,488,527
Members
407,643
Latest member
samerf86

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top