VBA Loop Copy & Vertical Paste 2 data points based on [3rd] Criteria
Results 1 to 8 of 8

Thread: VBA Loop Copy & Vertical Paste 2 data points based on [3rd] Criteria
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Apr 2013
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    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
    Job Policy 1 Policy 2 Policy 3
    Electrician-Journeyman Required Required Required
    Facilities Maintenance Required Required Required
    Maintenance Manager Required Required Required
    QA Manager N/A Required N/A
    Warehouse Manager N/A N/A Required


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

  2. #2
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,834
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

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

    Try this for results on sheet2.
    Code:
    Sub MG26Jun08
    Dim ray As Variant, c As Long, Ac As Long, n As Long
    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
    For Ac = 2 To UBound(ray, 2)
        For n = 2 To UBound(ray, 1)
           If ray(n, Ac) = "Required" Then
            c = c + 1
            nray(c, 1) = ray(1, Ac)
            nray(c, 2) = ray(n, 1)
           End If
        Next n
    Next Ac
    With Sheets("Sheet2").Range("A1").Resize(c, 2)
        .Value = nray
        .Borders.Weight = 2
        .Columns.AutoFit
    End With
    End Sub
    Regards Mick

  3. #3
    New Member
    Join Date
    Apr 2013
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    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...

  4. #4
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,834
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

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

    You're welcome

  5. #5
    New Member
    Join Date
    Apr 2013
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    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?

  6. #6
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,834
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

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

    Try this:-
    This code now returns the string in the intersecting cells (column 3 sheet2) rather than based on the word "Required".
    Code:
    Sub MG27Jun31
    Dim ray As Variant, c As Long, Ac As Long, n As Long
    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
    For Ac = 2 To UBound(ray, 2)
        For 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)
        Next n
    Next Ac
    With Sheets("Sheet2").Range("A1").Resize(c, 3)
        .Value = nray
        .Borders.Weight = 2
        .Columns.AutoFit
    End With
    End Sub
    Regards Mick

  7. #7
    New Member
    Join Date
    Apr 2013
    Posts
    28
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    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!

  8. #8
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,834
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

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

    You're welcome

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •