VBA Copy Paste Problem

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
 
G

Guest

It may be becasue of upper and lowercase X?

Why not use the auto filter and select on the X.
 
T

Tom Ogilvy

Are the cells in column A blank if they don't contain an X.

Sub List01()
Dim rng as Range, rng1 as Range
Worksheets("Master").Activate
On Error Resume Next
set rng = Columns(1).Specialcells(xlconstants,xlTextValues)
On Error goto 0
if rng is nothing then
msgbox "No X's in column A")
exit sub
End if
set rng1 = Worksheets("List").Cells(rows.count,1).End(xlup)
if not isempty(rng1) then set rng1 = rng1.offset(1,0)
rng.entireRow.copy Destination:=rng1
Print01
End Sub
 
R

Richard Slacum

Yes the cells are blank.



Tom Ogilvy said:
Are the cells in column A blank if they don't contain an X.

Sub List01()
Dim rng as Range, rng1 as Range
Worksheets("Master").Activate
On Error Resume Next
set rng = Columns(1).Specialcells(xlconstants,xlTextValues)
On Error goto 0
if rng is nothing then
msgbox "No X's in column A")
exit sub
End if
set rng1 = Worksheets("List").Cells(rows.count,1).End(xlup)
if not isempty(rng1) then set rng1 = rng1.offset(1,0)
rng.entireRow.copy Destination:=rng1
Print01
End Sub

--
Regards,
Tom Ogilvy



Richard Slacum said:
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
Click to expand...
Click to expand...
 
R

Richard Slacum

Tom, that worked great thanks...I still don't understand why my code stopped
working at row 37?



Tom Ogilvy said:
Are the cells in column A blank if they don't contain an X.

Sub List01()
Dim rng as Range, rng1 as Range
Worksheets("Master").Activate
On Error Resume Next
set rng = Columns(1).Specialcells(xlconstants,xlTextValues)
On Error goto 0
if rng is nothing then
msgbox "No X's in column A")
exit sub
End if
set rng1 = Worksheets("List").Cells(rows.count,1).End(xlup)
if not isempty(rng1) then set rng1 = rng1.offset(1,0)
rng.entireRow.copy Destination:=rng1
Print01
End Sub

--
Regards,
Tom Ogilvy



Richard Slacum said:
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
Click to expand...
Click to expand...
 
T

Tom Ogilvy

I would assume because you are building a string and after a certain length,
the string gets too long to use as an argument to Range.


--
Regards,
Tom Ogilvy

Richard Slacum said:
Tom, that worked great thanks...I still don't understand why my code stopped
working at row 37?



Tom Ogilvy said:
Are the cells in column A blank if they don't contain an X.

Sub List01()
Dim rng as Range, rng1 as Range
Worksheets("Master").Activate
On Error Resume Next
set rng = Columns(1).Specialcells(xlconstants,xlTextValues)
On Error goto 0
if rng is nothing then
msgbox "No X's in column A")
exit sub
End if
set rng1 = Worksheets("List").Cells(rows.count,1).End(xlup)
if not isempty(rng1) then set rng1 = rng1.offset(1,0)
rng.entireRow.copy Destination:=rng1
Print01
End Sub

--
Regards,
Tom Ogilvy



Richard Slacum said:
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
Click to expand...
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Error with calling Format sub 7
Convert code to lookup three criteria return fourth 15
Excel VBA help: Text file formatting 19
Replacing the formula text's substring 2
Loop to copy paste rows base on table arrays 0
Modify Claus code "Sub Array_Var_Column_Sort()" 27
Run two macros for two different sheets 11
Code Fails at this Line: .Refresh BackgroundQuery:=False 1

Top