Insert Rows Between Different Data < 2

[liam_conor]

I have a macro that loops throught all of the worksheets in a workbook and places a row inbetween all data that is different than from each other in column "A". However, it will not insert a row between data in column "A" if the different data is less than 2 in number.

Here it what I have so far:

Sub WorkshAct()
Dim ShList()
Dim ShCount As Integer
Dim x As Integer
ShCount = ActiveWorkbook.Sheets.Count
ReDim Preserve ShList(1 To ShCount)

For x = 2 To ShCount

Sheets(x).Select
InsertRows

Next x

End Sub


Sub InsertRows()
Dim iRow As Long
Dim iCount As Integer
iCount = 0

For iRow = [a65536].End(xlUp).Row - 1 To 3 Step -1

If Not IsEmpty(Cells(iRow, 1)) Then

If Cells(iRow, 1) <> Cells(iRow - 1, 1) Then

Rows(iRow).Insert

iCount = iCount + 1

End If

End If

Next iRow

End Sub

Any ideas/examples of how to do this?

 

[onlyadrafter]

Hello,

I think all you have to do is to change

For X = 2 to ShCount

to

For X = 1 to ShCount.

This works on Excel 97. Hope it works for you too!

 

[onlyadrafter]

Sorry,

My cut and paste went a bit doo-lally,

You also need to change

For iRow = [a65536].End(xlUp).Row -1 To 3 Step -1


to

For iRow = [a65536].End(xlUp).Row To 3 Step -1

This does work on my machine.

I hope you find this helpful.

 

[onlyadrafter]

Guess what?

Just found another potential problem. If cell A1 is different to A2, these will not be separated either, but.....

if you change this

For iRow = [a65536].End(xlUp).Row 3 Step -1

to

For iRow = [a65536].End(xlUp).Row To 2 Step -1

then they do get separated.

Hope you are not finding all these replies too tedious!

 

[Chitosunday]

Looks fine to me except the shlist and icount has no contribution in your macro but it still works. Based on the code, your macro will not go to sheet1 but to sheet2 automatically unless you replace "for x =2 to shcount" to "for x=1 to shcount" then
the last cell and second last cell will not insert row if they are different unless you change "For iRow = [a65536].End(xlUp).Row - 1 To 3 Step -1 " to "For iRow = [a65536].End(xlUp).Row To 3 Step -1 "

 

[Ekim]

Your WorkshAct macro is fine.

Try:

Sub InsertRows()
  Dim r As Long, mcol As String, i As Long

' find last used cell in Column A
  r = Cells(Rows.Count, "A").End(xlUp).Row

 ' get value of  last used cell in column A
  mcol = Cells(r, 1).Value

 ' insert rows by looping from bottom
  For i = r To 2 Step -1
     If Cells(i, 1).Value <> mcol Then
       mcol = Cells(i, 1).Value
        Rows(i + 1).Insert
     End If
  Next i

End Sub

In each worksheet, your data can start in any row, except for row 1.

HTH

Mike

 

[liam_conor]

Brilliant!

 

[rchtan]

Your WorkshAct macro is fine.

Try:

Sub InsertRows()
  Dim r As Long, mcol As String, i As Long
 
' find last used cell in Column A
  r = Cells(Rows.Count, "A").End(xlUp).Row
 
 ' get value of  last used cell in column A
  mcol = Cells(r, 1).Value
 
 ' insert rows by looping from bottom
  For i = r To 2 Step -1
     If Cells(i, 1).Value <> mcol Then
       mcol = Cells(i, 1).Value
        Rows(i + 1).Insert
     End If
  Next i
 
End Sub

In each worksheet, your data can start in any row, except for row 1.

HTH

Mike

Hi Mike

Can the codes been modified t insert 3 new lines?

Thanks

 

[shawrod]

I am trying to use the same code for column “C” and when I replaced “A” with “C” in the code that "Ekim" wrote, it doesn’t work, does anyone know why?

 

[postandin77]

Your WorkshAct macro is fine.

Try:

Sub InsertRows()
  Dim r As Long, mcol As String, i As Long

' find last used cell in Column A
  r = Cells(Rows.Count, "A").End(xlUp).Row

 ' get value of  last used cell in column A
  mcol = Cells(r, 1).Value

 ' insert rows by looping from bottom
  For i = r To 2 Step -1
     If Cells(i, 1).Value <> mcol Then
       mcol = Cells(i, 1).Value
        Rows(i + 1).Insert
     End If
  Next i

End Sub

In each worksheet, your data can start in any row, except for row 1.

HTH

Mike

This is great. Very cool. Looking for a way to have the process stop at row 3. ROW 1 2 and 3 are headers.
Also I needed two row between unlike data so I am using this script.

Sub InsertRows()
  Dim r As Long, mcol As String, i As Long

' find last used cell in Column A
  r = Cells(Rows.Count, "A").End(xlUp).Row

 ' get value of  last used cell in column A
  mcol = Cells(r, 1).Value

 ' insert rows by looping from bottom
  For i = r To 2 Step -1
     If Cells(i, 1).Value <> mcol Then
       mcol = Cells(i, 1).Value
        Rows(i + 1).Insert
        Rows(i + 1).Insert
     End If
  Next i

End Sub

Thank you Mike, This is going to add years onto my life .