Solved: while loop

[austenr]

I have a column of data (column A) of which I only wish to copy the rows with numbers in Column A. How can I modify the code below to accomplish this? Thanks

[VBA] Option Explicit
Sub copyrows()
Dim mI As Long
mI = 1
While Sheets("Sheet1").Cells(mI, 1) <> vbNullString
Sheets("Sheet1").Rows(mI).Copy
Sheets("sheet2").Select
Rows(mI).Select
ActiveSheet.Paste
mI = mI + 1
Wend
End Sub[/VBA]

[Killian]

If you use a do/while loop, as soon as the condition isn't met, the loop will exit.
I think you need to use a For/Next loop for the range concerned[VBA]Sub copyrows()

Dim mI As Long
Dim mLastRow As Long

mLastRow = xlLastRow("Sheet1")
If mLastRow <> 0 Then
For mI = 1 To mLastRow
If Not IsEmpty(Sheets("Sheet1").Cells(mI, 1)) Then
Sheets("Sheet1").Rows(mI).Copy (ActiveSheet.Rows(mI))
End If
Next mI
End If

End Sub

Function xlLastRow(Optional WorksheetName As String) As Long
'from MWE's kb entry to find the last populated row :-)

With Worksheets(WorksheetName)
On Error Resume Next
xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
xlWhole, xlByRows, xlPrevious).Row
If Err <> 0 Then xlLastRow = 0
End With

End Function[/VBA]It's also worth pointing out that While/Wend is obsolete and included in VB for backwards compatability

[austenr]

That copies all rows. What I was looking for was a way to copy just the cells with numbers in them. ex.

aaa
111
222
bbb
ccc
ddd
333

I only want to copy 111,222,333. Hope that is more clear. Thanks

[austenr]

I got it working sort of. It copies the rows with just the numbers but on rows where there are text, sheet 2 is a blank row. What is a way around it?

[Killian]

Ahh, I see! Numbers as opposed to text or empty or whatever...
You can just replace "IsEmpty" with "IsNumeric"
IsNumeric returns true if the expression can be evaluated as a number

[austenr]

in other words it should end up this way on sheet 2:

111
222
333
etc.

[Shazam]

Would this help!


[VBA]
Sub Test2()
Dim x As Range
Set x = Sheets("Sheet1").Range("A1:B1000")
With Sheets("Sheet1")
.AutoFilterMode = False
x.AutoFilter Field:=1, Criteria1:=">1"
x.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Range("A1")
.AutoFilterMode = False
End With
End Sub
[/VBA]

[Killian]

ahh, ok, next thing is you don't want them on the corresponding row on sheet2. You don't want the blanks.
I suppose adding a separate counter for the destination row will do it
And while I was testing this I noticed that an empty cell will evaluate as 0 with IsNumeric so you'll need to test for Not IsEmpty as well[VBA]Sub copyrows()

Dim mI As Long
Dim mLastRow As Long
Dim mDestRow As Long

mDestRow = 1
mLastRow = xlLastRow("Sheet1")
If mLastRow <> 0 Then
For mI = 1 To mLastRow
If Not IsEmpty(Sheets("Sheet1").Cells(mI, 1)) And IsNumeric(Sheets("Sheet1").Cells(mI, 1)) Then
Sheets("Sheet1").Rows(mI).Copy (ActiveSheet.Rows(mDestRow))
mDestRow = mDestRow + 1
End If
Next mI
End If

End Sub

Function xlLastRow(Optional WorksheetName As String) As Long
'from MWE's kb entry to find the last populated row :-)

With Worksheets(WorksheetName)
On Error Resume Next
xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
xlWhole, xlByRows, xlPrevious).Row
If Err <> 0 Then xlLastRow = 0
End With

End Function[/VBA]

[austenr]

Both work as advertised. Thanks to you both. I will evaluate which one I want to use and understand better. Solved.