How to make a sub that stops when it finds a blank cell?

Question

I was working on a database in Excell 2010 and found many duplicated names. I tried to make a VBA Script to solve this, but it just ends on a infinite loop. I wanted it to stop when it hits a blank cell. Heres the code I came up with

Sub excluirDuplicatas()

   Dim lngCont As Long
   Dim lngLinhas As Long
   Dim rngNom1 As Range
   Dim rngNom2 As Range

lngCont = 0
lngLinhas = Cells.SpecialCells(xlCellTypeLastCell).Row

While lngCont <= lngLinhas

Set rngNom1 = ActiveCell
Set rngNom2 = rngNom1.Offset(1, 0)

While rngNom1.Value = rngNom2.Value And rngNom2 <> lastRow


rngNom2.Select
rngNom2.EntireRow.Delete
Set rngNom2 = ActiveCell
Wend


Set rngNom1 = rngNom2
Set rngNom1 = ActiveCell



Set rngNom1 = rngNom2
rngNom1.Select

lngCont = lngCont + 1

Wend

End Sub

I don't know whats wrong, my guess is the part where I state

rngNom2 <> Cells.SpecialCells(xlCellTypeLastCell).Row

Please be aware that I starded VBA Programing today(March 22th). If you could please post not only the answer but also a quick explanation I would appreciate.

PS: The data sheet has over 2000 lines long

Can you describe more specifically what it is you're trying to accomplish... Maybe we could show you nicer code to do the task... FOR EXAMPLE, In Excel, if you select your range and press `F5`, click `Special` and select `Blanks`, that will find all the blank cells in your range... If you then hit `Shift` + `Space Bar`, that will select the entire row... You can then delete that row (if that is what you were trying to do)... So, if you record a macro doing that, you can get what you want in 10 lines of code or less... — John Bustos, Mar 22 '13 at 20:26

score 2 · Accepted Answer · edited May 23 '17 at 12:04

2

I would recommend using a For Loop so that you can avoid using .Select You might want to see THIS LINK

So for example your code will look something like this

For i = 1 To lastRow
    If Len(Trim(Sheets("Sheet1").Range("A" & i).Value)) = 0 Then Exit For

    '
    '~~> Rest of your code
    '
Next i

edited May 23 '17 at 12:04

Community

1
1

answered Mar 22 '13 at 20:28

Siddharth Rout

147,039
17
206
250

Thanks, but I acctualy used the lastRow argument and it worked out just fine. But i'll keep in mind the use of the "For" routine for my next codes! – Pedro Mar 22 '13 at 20:38
@Pedro: If you are sure that there is no blank cell before the last row then you may see this link as well to find the last row... http://stackoverflow.com/questions/11169445/error-finding-last-used-cell-in-vba – Siddharth Rout Mar 22 '13 at 20:42

score 0 · Answer 2 · edited Mar 22 '13 at 20:30

0

I think this command will help you. Replace Range("a1") with whatever range you want to test.

IsEmpty(Range("a1"))

ie, do while isempty(range("a1"))... or do while not isempty(range("a1"))

edited Mar 22 '13 at 20:30

Siddharth Rout

147,039
17
206
250

answered Mar 22 '13 at 20:22

user2200765

21
1
1
5

score 0 · Answer 3 · answered Mar 22 '13 at 20:40

Well I'm not 100% sure what you're doing, but this would be a start.

Start by declaring a range variable rng taht contains all the cells you want to examine. The way I have set this rng variable automatically stops at the first blank cell in the column.

We will use the counter r to iterate over these cells, from last to first (this is necessary when deleting).

We will use a variable cl as a single cell range, during this iteration.

Sub excluirDuplicatas()

Dim rng as Range
Dim r as Integer 'row counter.
Dim cl As Range


lngCont = 0
lngLinhas = Cells.SpecialCells(xlCellTypeLastCell).Row

set rng = Range(ActiveCell.Address, Range(ActiveCell.Address).End(xlDown)) 

For r = rng.Rows.Count to 1 Step - 1 'Step backwards when deleting, otherwise you have infinite loop

    'This tests to see if the cell value is the same as the value below it.
     ' and deletes it if it is the same value.
    If cl.Value = cl.Offset(1,0).Value Then
        cl.EntireRow.Delete

    End If
Next

End Sub

How to make a sub that stops when it finds a blank cell?

3 Answers3