Improving this code

[Guest]

Hi guys, I wonder if someone may help me to improve this code, basically read
the worksheet "Personal Budget" until it find the word Final, the are some
empty lines that is why I ask if the cell is not empty, if is not empty I
copy the information sequentially to the worksheet where I am running the
Command Button, this code works but I was wondering if there is a way to
improved, maybe there is a way to do it without the do while cycle.

Thanks

Private Sub CommandButton1_Click()
Dim Row As Integer, row2 As Integer, Count As Integer
Row = 1
row2 = 5

Do While Worksheets("Personal Budget").Cells(row2, 2) <> "Final"
If Worksheets("Personal Budget").Cells(row2, 2) <> "" Then
Cells(Row, 1) = Worksheets("Personal Budget").Cells(row2, 2).Value
Row = Row + 1
End If
row2 = row2 + 1
Loop
End Sub

 

[Jim Rech]

One way:

Sub NoWhile()
Dim FinalCell As Range
With Worksheets("Personal Budget")
Set FinalCell = .Columns(2).Find("Final")
If Not FinalCell Is Nothing Then
.Range(.Cells(5, 2), FinalCell.Offset(-1)) _
.SpecialCells(xlCellTypeConstants).Copy
Cells(1, 2).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
End With
End Sub

 

[Guest]

Your code is pretty efficient. Here is another way of doing the same thing

RowCount = 1
with Worksheets("Personal Budget")
LastRow = .cells(rows.count,"B").end(xlup).row
Set ColBRange = range(.cells(1,"B"),.cells(LastRow,"B"))

set c = ColBRange.Find(what:="Final",lookin:=xlvalues)
if not c is nothing then

Set ColBRange = range(.cells(1,"B"),.cells(c.Row,"B"))
for each cell in ColBRange
if not isempty(cell) then
.Cells(RowCount, 1).value = cell
RowCount = RowCount + 1
end if
next cell
end if