Results 1 to 7 of 7
  1. #1
    New Lounger
    Join Date
    May 2014
    Posts
    5
    Thanks
    0
    Thanked 0 Times in 0 Posts

    VBA for Excel to copy rows

    I have a spreadsheet with 2 columns....opportunity Name and Description

    Both are text fields and the values in the Description field are separated by spaces

    Example
    Opty Name Description
    RET SS NAF804390 NAF804390
    NBS CM VXX104647 VXX104623 VXX104647 VXX104623
    NBS CM MX4342832 MX1197204 MX1197222 LX7377792 MX4342832 MX1197204 MX1197222 LX7377792

    What I am trying to do is split/copy the rows with more than 1 value in the Description field and copy the Opportunity name as well

    Like This
    Opty Name Description
    RET SS NAF804390 NAF804390
    NBS CM VXX104647 VXX104623 VXX104647
    NBS CM VXX104647 VXX104623 VXX104623
    NBS CM MX4342832 MX1197204 MX1197222 LX7377792 MX4342832
    NBS CM MX4342832 MX1197204 MX1197222 LX7377792 MX1197204
    NBS CM MX4342832 MX1197204 MX1197222 LX7377792 MX1197222
    NBS CM MX4342832 MX1197204 MX1197222 LX7377792 LX7377792

    Is this possible? I am completely lost

    Thanks in advance

    Bret
    Last edited by Mindbender; 2014-05-07 at 09:38. Reason: add attachment

  2. Subscribe to our Windows Secrets Newsletter - It's Free!

    Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    New Lounger
    Join Date
    May 2014
    Posts
    5
    Thanks
    0
    Thanked 0 Times in 0 Posts
    the formatting was wonky above so I attached the file
    Attached Files Attached Files

  4. #3
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,509
    Thanks
    3
    Thanked 143 Times in 136 Posts
    This code appears to work. The core part is relatively simple but some if statements were needed to deal with non-obvious problems such as multiple spaces or empty description fields.
    Code:
    Sub DoIt()
      Dim rng As Range, aCell As Range, i As Integer, j As Integer
      Dim sDesc() As String
      
      Set rng = ActiveSheet.UsedRange
      For i = rng.Rows.Count To 1 Step -1
        'debug.Print rng.Cells(i, 2)
        If Len(rng.Cells(i, 2)) > 0 Then
          sDesc = Split(rng.Cells(i, 2), " ")
          For j = UBound(sDesc) To 1 Step -1
            If Len(sDesc(j)) > 0 Then
              rng.Rows(i + 1).Insert
              rng.Cells(i + 1, 1).Value = rng.Cells(i, 1).Value
              rng.Cells(i + 1, 2).Value = sDesc(j)
            End If
          Next j
          rng.Cells(i, 2) = sDesc(0)
        End If
      Next i
    End Sub
    Last edited by Andrew Lockton; 2014-05-08 at 07:33.
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  5. #4
    New Lounger
    Join Date
    May 2014
    Posts
    5
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Thank you so much Andrew - this is awesome

    Bret

  6. #5
    New Lounger
    Join Date
    May 2014
    Posts
    5
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Hi Andrew,

    Is there something I need to do if I add fields to the worksheet. I tried adding the other fields I need and the VBA seems to not do anything now. I have attached the spreadsheet with all the fields

    Thanks and sorry to bother you

    Bret
    Attached Files Attached Files

  7. #6
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,509
    Thanks
    3
    Thanked 143 Times in 136 Posts
    Bret

    The code as provided previously was based on the question you asked at the time. The following code has been modified so you can learn to change this yourself.
    Since your input data is different (no double spaces in description field), I removed one of the If statements to simplify it.
    Code:
    Sub DoIt2()
      Dim rng As Range, i As Integer, j As Integer
      Dim sDesc() As String
      Dim iCol As Integer
      
      Set rng = ActiveSheet.UsedRange             'define the range to process with the code
      iCol = 8                                    'column # that determines whether to duplicate that row
      For i = rng.Rows.Count To 1 Step -1         'start at the bottom of the range and work up through the rows
        If Len(rng.Cells(i, iCol)) > 0 Then       'if there is any content in column iCol
          sDesc = Split(rng.Cells(i, iCol), " ")  'create an array by splitting at any spaces
          For j = UBound(sDesc) To 1 Step -1      'if the array contains more than one entry, loop from the end going forward
            rng.Rows(i + 1).Insert                          'add an empty row
            rng.Rows(i).Copy Destination:=rng.Rows(i + 1)   'copy the entire row into the following new row
            rng.Cells(i + 1, iCol).Value = sDesc(j)         'change the value of the cell in column iCol to the array entry
          Next j
          rng.Cells(i, iCol) = sDesc(0)            'write the value of the first array entry to this cell
        End If
      Next i
    End Sub
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  8. #7
    New Lounger
    Join Date
    May 2014
    Posts
    5
    Thanks
    0
    Thanked 0 Times in 0 Posts
    thank you so much. I definatly prefer being taught how to fish

    Bret

Posting Permissions

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