Results 1 to 7 of 7
  1. #1
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,826
    Thanks
    136
    Thanked 482 Times in 459 Posts

    vba to insert rows

    I have a column of cells in range [K11] to [K115]

    These cells contain integer values from 11 to 150.
    The values are in ascending order.
    There are gaps in the sequence, e.g. 11,12,13,14,19,20,21,22,30,31,32,33,..,147,148,149 ,150

    If these numbers represent row numbers, I would like rows to be inserted via vba where there are gaps in the sequence.
    So, as in the example above, after row 14, insert rows until row 19 contains the value 19.
    After row 22, insert rows until row 30 contains the value 30 etc etc.

    On completion, row 150 in column [K] should contain the value 150 etc.

    Any suggestions would be most appreciated.

    zeddy

  2. #2
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Zeddy,

    How about something like this? I am assuming that the value in the cell will never be less than the row it is in. I will leave it in your capable hands to adjust the code if you need to insert additional entries and run the code again as this will throw the values/rows off

    Maud

    Code:
    Public Sub MatchRows()
    Dim rng As Range
    Dim cell As Range
    Set rng = Range("K11:K115")
    For Each cell In rng
        If cell <> "" Then
            diff = cell - cell.Row
            If diff > 0 Then
                For I = 1 To diff
                    Cells.Rows(cell.Row).Insert Shift:=xlDown
                Next I
            End If
        End If
    Next cell
    End Sub
    Last edited by Maudibe; 2014-03-20 at 22:44.

  3. The Following User Says Thank You to Maudibe For This Useful Post:

    zeddy (2014-03-21)

  4. #3
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,826
    Thanks
    136
    Thanked 482 Times in 459 Posts
    Hi Maud

    Your assumption is correct.
    Top marks! Exactly what I needed.
    Many thanks.
    I can tweak to fit my needs.
    The morphine is distracting my coding.

    zeddy

  5. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,637
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Funny, it would probably improve mine!

  6. #5
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Another scheme which may be more efficient would be to create a temp column with the values in K, and fill in the rows above with and the rows afterwards with the "missing values". Then sort based on this temp column. Then the temp column can be deleted. This will give the same results as inserting the rows, without actually having to insert the rows (which can be a slow process in practice.

    Code:
    Option Explicit
    Sub MakeRows()
      Dim wks As Worksheet
      Dim iCol As Integer
      Dim lRowStart As Long
      Dim rng As Range
      Dim x As Long
      Dim lRow As Long
      Dim lNum As Long
      Dim lMax As Long
      
      'change as desired
      iCol = 11 ' Col K
      Set wks = ActiveSheet
    
      Application.ScreenUpdating = False
      On Error GoTo ErrHandler
      With wks
        'add temp column
        .Columns(iCol).Copy
        .Columns(iCol).Insert Shift:=xlToRight
        lRowStart = .Cells(1, iCol).End(xlDown).Row
        lRow = .Cells(.Rows.Count, iCol).End(xlUp).Row
        Set rng = .Range(.Cells(lRowStart, iCol), .Cells(lRow, iCol))
        lMax = Application.WorksheetFunction.Max(rng)
        lRow = 1
        For lNum = 1 To lMax
          x = 0
          On Error Resume Next
          'Check if number already there      
          x = Application.WorksheetFunction.Match(lNum, rng, 0)
          On Error GoTo ErrHandler
          If x = 0 Then
            'Match found, Skip rows if there already is a number
            Do While .Cells(lRow, iCol) <> ""
              lRow = lRow + 1
            Loop
            'Enter new value
            .Cells(lRow, iCol) = lNum
          End If
        Next
        'sort the temp column
        .UsedRange.Sort .Cells(1, iCol), xlAscending
        'delete the temp column
        .Columns(iCol).EntireColumn.Delete
      End With
    ExitHandler:
        Application.ScreenUpdating = True
        Exit Sub
    ErrHandler:
        MsgBox Err.Number & Err.Description
        Resume ExitHandler
    End Sub
    Steve
    Last edited by sdckapr; 2014-03-21 at 08:16.

  7. The Following User Says Thank You to sdckapr For This Useful Post:

    zeddy (2014-03-25)

  8. #6
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,826
    Thanks
    136
    Thanked 482 Times in 459 Posts
    Hi Steve

    Apologies for delayed response - I'm being re-admitted back to Hospital today. Ouch.

    Your efficient 'sort' solution is how I was originally thinking, but I was a bit muddled at the time.
    Many thanks - I will be using this method for some parts of my task.
    Maud's method was particularly useful because it allowed me to do some other required stuff as each row was being inserted.

    many thanks again to both of you. Really helped me out.

    zeddy

  9. #7
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    Glad I could help. I hope you are feeling better and less muddled.

    Steve

Posting Permissions

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