ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VBA Copy Paste Problem (https://www.excelbanter.com/excel-programming/349082-vba-copy-paste-problem.html)

Richard Slacum

VBA Copy Paste Problem
 
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




Martin Fishlock[_3_]

VBA Copy Paste Problem
 
It may be becasue of upper and lowercase X?

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

--
HTHs Martin


"Richard Slacum" wrote:

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





Tom Ogilvy

VBA Copy Paste Problem
 
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" wrote in message
...
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






Richard Slacum

VBA Copy Paste Problem
 
Yes the cells are blank.



"Tom Ogilvy" wrote in message
...
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" wrote in message
...
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








Richard Slacum

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



"Tom Ogilvy" wrote in message
...
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" wrote in message
...
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








Tom Ogilvy

VBA Copy Paste Problem
 
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" wrote in message
...
Tom, that worked great thanks...I still don't understand why my code

stopped
working at row 37?



"Tom Ogilvy" wrote in message
...
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" wrote in message
...
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











All times are GMT +1. The time now is 05:27 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com