PDA

View Full Version : Solved: while loop



austenr
10-14-2005, 06:22 AM
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

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

Killian
10-14-2005, 07:11 AM
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 concernedSub 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 FunctionIt's also worth pointing out that While/Wend is obsolete and included in VB for backwards compatability

austenr
10-14-2005, 07:21 AM
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
10-14-2005, 07:42 AM
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
10-14-2005, 07:43 AM
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
10-14-2005, 07:49 AM
in other words it should end up this way on sheet 2:

111
222
333
etc.

Shazam
10-14-2005, 07:51 AM
Would this help!



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

Killian
10-14-2005, 07:53 AM
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 wellSub 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

austenr
10-14-2005, 08:01 AM
Both work as advertised. Thanks to you both. I will evaluate which one I want to use and understand better. Solved.