CODEWITHSUNDEEP
excelvba
user15730901
user15730901

Reputation:

Loop through column that has blanks - excel

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,

Upvotes: 1

Views: 391

Answers (2)

Nicholas Hunter
Nicholas Hunter

Reputation: 1845

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

Upvotes: 1

VBasic2008
VBasic2008

Reputation: 54807

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

Upvotes: 0

Related Questions