PDA

View Full Version : Shortcut to inserting rows



PJSR
10-01-2007, 01:35 AM
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

Bob Phillips
10-01-2007, 01:59 AM
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

Charlize
10-01-2007, 02:01 AM
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).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

PJSR
10-01-2007, 02:17 AM
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).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

Thanks. Replaced file.