R
Richard Slacum
Complex Help
I wrote and stole some VBA to do the following.
Basically what I'm trying to do is to print only the rows that column "A"
have an "X" in, but it only works up to approximately 37 rows.any more and
it will not copy.
I'm totally confused on this; any help would greatly be appreciated.
Here is the code thanks.
Rich,
Sub List01()
'Copy all rows with column 1 matching value
' of selected cell to next available row
Application.ScreenUpdating = False
Sheets("Master").Select
Range("A1").Select
On Error Resume Next
Dim mrow As Long
mrow = Cells.SpecialCells(xlLastCell).Row
Dim ThisText As String
Dim Str1 As String
Dim Row As Long
ThisText = "X"
For I = 1 To mrow
If Cells(I, 1) = ThisText Then
Str1 = Str1 & "," & I & ":" & I
End If
Next I
Str1 = Mid(Str1, 2, 2000)
Range(Str1).Copy
Sheets("List").Activate
Range("A1").Select
If [A1].Value <> "" Then
Cells(1, 2).End(xlDown).Select
Row = ActiveCell.Row
Range(Cells(Row + 1, 1), Cells(Row + 1, 1)).Select
End If
ActiveSheet.Paste
Sheets("Master").Activate
Application.ScreenUpdating = False
Application.CutCopyMode = False
Call Print01
End Sub
I wrote and stole some VBA to do the following.
Basically what I'm trying to do is to print only the rows that column "A"
have an "X" in, but it only works up to approximately 37 rows.any more and
it will not copy.
I'm totally confused on this; any help would greatly be appreciated.
Here is the code thanks.
Rich,
Sub List01()
'Copy all rows with column 1 matching value
' of selected cell to next available row
Application.ScreenUpdating = False
Sheets("Master").Select
Range("A1").Select
On Error Resume Next
Dim mrow As Long
mrow = Cells.SpecialCells(xlLastCell).Row
Dim ThisText As String
Dim Str1 As String
Dim Row As Long
ThisText = "X"
For I = 1 To mrow
If Cells(I, 1) = ThisText Then
Str1 = Str1 & "," & I & ":" & I
End If
Next I
Str1 = Mid(Str1, 2, 2000)
Range(Str1).Copy
Sheets("List").Activate
Range("A1").Select
If [A1].Value <> "" Then
Cells(1, 2).End(xlDown).Select
Row = ActiveCell.Row
Range(Cells(Row + 1, 1), Cells(Row + 1, 1)).Select
End If
ActiveSheet.Paste
Sheets("Master").Activate
Application.ScreenUpdating = False
Application.CutCopyMode = False
Call Print01
End Sub