VBA in Excel...I'm clueless 2

[SpyderMan1234]

I am looking for a way for Excel to insert a new row when a certain series of numbers changes. e.g...

From this:

1234
1234
5546
5546
5465
7895
7895

To This:

1234
1234

5546
5546

5465

7895
7895

I'm assuming that this can only be done via VBA. Anyone have any clues on how to do it?? Thanks in advance.

 

[123FakeSt]

Sub insert_spaces()

Dim last_row as Long
Dim cur_row as String
Dim prev_row as string
Dim f as integer

last_row = Cells(65536, 1).End(xlUp).Row
For f = 2 to last_row
cur_row = Cells(f, 1)
prev_row = Cells(f - 1, 1)
If cur_row <> prev_row And prev_row <> "" Then
Rows(f).Select
Selection.Insert Shift:=xlDown
last_row = last_row + 1
End If
Next F

End Sub

 

[123FakeSt]

Actually .. that still doesn't accomodate the extra rows due to the inserts. This works better (of course you can only end up doubling the number of rows thus the 'last_row * 2' ...

Dim last_row As Long
Dim cur_row As String
Dim prev_row As String
Dim f As Integer

last_row = Cells(65536, 1).End(xlUp).Row
For f = 2 To last_row * 2
cur_row = Cells(f, 1)
prev_row = Cells(f - 1, 1)
If cur_row <> prev_row And prev_row <> "" Then
Rows(f).Select
Selection.Insert Shift:=xlDown
End If
Next f

 

[TonyJollans]

Hi SpyderMan1234,

You could, obviously, do it in code, but with a bit of trickery you could do it without code, like this:

If your column doesn't have a header, insert a row at the top and give it a name.
Select your column.
Select Data > Subtotals... from the Menu

You can probably accept the defaults, but make sure Summary below data is checked, and Press OK

You will now have a column to the left of your numbers, which will be selected.
Extend the selection to include your original column (Press <Shift><Right Arrow>)
Select Data > Filter > Autofilter from the Menu

From the dropdown (in the top cell of the new column) Select (NonBlanks)
Press the <Delete> Key

Reduce the selection down to the (now empty) column on the left (Press <Shift><Left Arrow>)
Press <Ctrl><-> to remove the column

If you inserted a header row, you can now delete it, and ..

..finally, Select Data > Group and Outline > Clear Outline to remove the outline created by the subtotaling.


Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

 

[xlbo]

Note to RustyAutom

When inserting rows or deleting rows, it is best to work from the bottom upwards - that way the row incrementing doesn't get affected

For i = Lastrow to 2 step -1


would be a better construct to use

Rgds, Geoff

Never test the depth of water with both feet

Help us to help you by reading FAQ222-2244 before you ask a question

 

[MakeItSo]

EXCELlent remark, Geoff.
Simple and efficient.

 

[Loomah]

Just because it's different...

This has taken Tony's suggestion and put it into code - just for the hell of it!

The difference using this method, if you have to do it multiple times, is that over 100 rows there would be no noticable time difference between this and looping. However over 30000 rows this would be a little quicker, I suspect.

This is something I've come accross before where instictively I'd go for a looping method. However when someone (like Tony) points out a manual method it becomes apparent that coding the manual method would be quicker than looping. Of course this could be irrelevant for one off jobs!

Note that in this code the AutoFilter method isn't required.

Sub InsertRowsAtDataChange()
Application.ScreenUpdating = False
    Rows("1:1").Insert Shift:=xlDown    'create header row
    With Range("A1")
        .FormulaR1C1 = "Heading"
        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
            Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        ActiveSheet.Outline.ShowLevels RowLevels:=2
        .CurrentRegion.SpecialCells(xlCellTypeVisible).ClearContents
        ActiveSheet.Outline.ShowLevels RowLevels:=3
        Columns("A:A").Delete Shift:=xlToLeft   'remove sub tots Column
        .ClearOutline
        Rows("1:1").Delete Shift:=xlUp  'remove header row
    End With
Application.ScreenUpdating = True
End Sub

;-)

If a man says something and there are no women there to hear him, is he still wrong?
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244

 

[123FakeSt]

Good point Geoff, i'm a freshie -- just trying to give something back for all of the help i've gotten!

Rusty

 

[xlbo]

Rusty - no probs. Very glad to hear it.

Rgds, Geoff

Never test the depth of water with both feet

Help us to help you by reading FAQ222-2244 before you ask a question