Consulting

Results 1 to 4 of 4

Thread: Shortcut to inserting rows

  1. #1
    VBAX Regular
    Joined
    Jul 2007
    Posts
    9
    Location

    Shortcut to inserting rows

    Hi,
    The best way to describe what I need to do will be by using an example:
    Currently I have information that reflects suburb detail and then the number of clients we have in each of those suburbs. I need to reflect the information only on suburb level for the charting software we use.

    The current format of the data:

    Suburb Number of clients
    Centurion 5
    Alberton 6

    I need to change it to look like this:

    Suburb
    Centurion
    Centurion
    Centurion
    Centurion
    Centurion
    Alberton
    Alberton
    Alberton
    Alberton
    Alberton
    Alberton

    I am currently using copy, paste and insert rows to do this but it's going to take me days to do this as we have 1000's to do.

    Is there an easier way of achieving this? I include a sheet reflecting an example of the current format.

    Thanks

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [vba]

    Public Sub ProcessData()
    Dim i As Long
    Dim iLastRow As Long

    With ActiveSheet

    Application.ScreenUpdating = False

    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = iLastRow To 4 Step -1

    If .Cells(i, "B").Value > 1 Then

    .Rows(i + 1).Resize(.Cells(i, "B").Value - 1).Insert
    .Cells(i + 1, "A").Resize(.Cells(i, "B").Value - 1).Value = .Cells(i, "A").Value
    End If
    Next i

    .Columns(2).Delete

    Application.ScreenUpdating = True
    End With

    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Master
    Joined
    Jul 2006
    Location
    Belgium
    Posts
    1,286
    Location
    You better use a lower version than 2007 to get some responses (or save in different format). Try this (not tested because I couldn't open your file).[VBA]Sub do_insert_no_row()
    Dim lrow As Long
    Dim vloop As Long
    Dim vloop2 As Long
    lrow = Range("A" & Rows.Count).End(xlUp).Row
    'Heading at row 1
    For vloop = lrow To 2 Step -1
    For vloop2 = 1 To Range("A" & vloop).Offset(, 1).Value - 1
    Range("A" & vloop).EntireRow.Insert (xlShiftDown)
    Range("A" & vloop).Value = Range("A" & vloop).Offset(1, 0).Value
    Next vloop2
    Next vloop
    End Sub[/VBA]

  4. #4
    VBAX Regular
    Joined
    Jul 2007
    Posts
    9
    Location
    Quote Originally Posted by Charlize
    You better use a lower version than 2007 to get some responses (or save in different format). Try this (not tested because I couldn't open your file).[vba]Sub do_insert_no_row()
    Dim lrow As Long
    Dim vloop As Long
    Dim vloop2 As Long
    lrow = Range("A" & Rows.Count).End(xlUp).Row
    'Heading at row 1
    For vloop = lrow To 2 Step -1
    For vloop2 = 1 To Range("A" & vloop).Offset(, 1).Value - 1
    Range("A" & vloop).EntireRow.Insert (xlShiftDown)
    Range("A" & vloop).Value = Range("A" & vloop).Offset(1, 0).Value
    Next vloop2
    Next vloop
    End Sub[/vba]
    Thanks. Replaced file.

Posting Permissions

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