1

I want to know how to loop this a column that blanks inside the column.

I am trying to run a script where if there is a group of a data together, it will make a new column. I got it from here: https://stackoverflow.com/a/15418263/15730901

The problem is that only works for the first column, if I try it a second time on a different column it will stop at the blank because of the loop condition. Is there anyway to change the loop condition to check for the whole column instead of stopping on a blank cell?

Code

sub AddBlankRows()
'
dim iRow as integer, iCol as integer
dim oRng as range

set oRng=range("a1")

irow=oRng.row
icol=oRng.column

do 
'
if cells(irow+1, iCol)<>cells(irow,iCol) then
    cells(irow+1,iCol).entirerow.insert shift:=xldown
    irow=irow+2
else
    irow=irow+1
end if
'
loop while not cells (irow,iCol).text=""
'
end sub

Thank you for your time,

BigBen
  • 46,229
  • 7
  • 24
  • 40
  • 1
    Side note: [Use `Long` instead of `Integer`](https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long). – BigBen Apr 22 '21 at 02:27

2 Answers2

1

Use Range.Find to find the last non-blank cell in the column

lastRow = Columns(iCol).Find("*", SearchOrder:=xlByRows, SearchDirections:=xlPrevious).Row

The your loop becomes

for iRow = lastRow - 1 to firstRow Step -1
    if cells(irow + 1, iCol) <> cells(irow,iCol) then
        cells(irow + 1,iCol).entirerow.insert shift:=xldown
    end if
next iRow
Nicholas Hunter
  • 1,791
  • 1
  • 11
  • 14
  • @BigBen I have made the changes you suggested. I think my original code might have worked as is or could have been made to work (maybe start at the second row and compare to row - 1 instead of start at the first row and compare to row + 1), but working backwards last row - 1 to first is the safer bet. This is a great example of why many programming situations it is illegal or dangerous to alter a list as you iterate through it. – Nicholas Hunter Apr 22 '21 at 10:34
0

Inserting a Row After a Group of Data

  • Here's a link to an answer that I posted where the OP was using the same code but wanted it to work for multiple columns. The question has been deleted by the author, so you may not have enough reputation to see it.

A Quick Fix

Option Explicit

Sub AddBlankRows()
    
    Dim rg As Range: Set rg = Range("A1")
    Dim r As Long: r = rg.Row
    Dim c As Long: c = rg.Column
    
    Dim lRow As Long: lRow = Range("A" & Rows.Count).End(xlUp).Row

    Do Until r > lRow
        If Len(Cells(r + 1, c).Value) > 0 And Len(Cells(r, c).Value) > 0 _
                And Cells(r + 1, c).Value <> Cells(r, c).Value Then
            Cells(r + 1, c).EntireRow.Insert Shift:=xlDown
            r = r + 2
        Else
            r = r + 1
        End If
    Loop
'
End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28