copy entire row and paste values only to another sheet

[drewship]

Hello all.

I have a module with the following code snippet I have been trying to modify:

Set wksPasteTo = Sheets("Closed_Requests")
Sheets("Closed_Requests").Select
'ActiveSheet.Unprotect pw
LR = Range("B" & Rows.Count).End(xlUp).Row
Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1))

Sheets("Distribution").Select
LastRow = Range("A65536").End(xlUp).Row

With Sheets("Distribution")
For x = LastRow To 1 Step -1
If Range("B" & x).Value = "Closed" Then
Range("B" & x).EntireRow.Copy
With Sheets("Closed_Requests")
wksPasteTo.Paste rngPasteTo
Set rngPasteTo = rngPasteTffset(1)
End With
Sheets("Distribution").Range("B" & x).EntireRow.Delete
End If
Next x
End With

I have seen several posts that use:

Sheets("Sheet1").Cells.SpecialCells(xlTextValues).EntireRow.Copy
Sheets("Sheet2").Cells.PasteSpecial Paste:=xlPasteValues

but I have been unable to figure out how to merge the above with my code.
There is one column 'B' that contains a color that I want to copy with the
data, but all the rest of the combo boxes and code need to be stripped from
the copied rows.

I have another module with the following different code snippet that I need
to copy and paste as above:

'create temporary worksheet
Set AllName1 = Worksheets.Add(After:=Sheets(Sheets.Count))
AllName1.Name = frmALL.AllName.Value

Set ws2 = ActiveSheet
ws2.Range("A1:" & colName & 1).Value = ws1.Range("A1:" & colName &
13).Value

With ws1
.Range("A2:" & colName & 1).Copy

With ws2.Range("A3:" & colName & 1)
ActiveSheet.Paste
.RowHeight = 12
Range("A3").Select

End With

'compares and copies data
With Source
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For x = 2 To LastRow
If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value <> "" And
..Cells(x, "C").Value >= lodate And .Cells(x, "C").Value <= hidate Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(x, "C")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then

'copies matched data to temporary sheet named by user
RowsWithNumbers.EntireRow.Copy AllName1.Range("A3")

End If

End With

'Clear old report
Sheets("All_Report").Range("A3:J" & Rows.Count).Clear

'Filter data based on dates chosen
LR = Range("A" & Rows.Count).End(xlUp).Row

'Copy data ranges
With ws2
.Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy
Sheets("All_Report").Range("A3")
With ws2
.Range("J3:K" & LR).SpecialCells(xlCellTypeVisible).Copy
Sheets("All_Report").Range("H3")
With ws2
.Range("O3:O" & LR).SpecialCells(xlCellTypeVisible).Copy
Sheets("All_Report").Range("J3")

End With
End With
End With

Any help with these would be greatly appreciated!!!!
Thanks!!!

 

[Joel]

mke this change

from
wksPasteTo.Paste rngPasteTo
to
wksPasteTo.PasteSpecial Paste:=xlPasteValues

 

[drewship]

Thanks for replying Joel.

I tried that but the Paste:= is hilighted and a 'Compile error: Named
argument not found' is displayed. Do I need to DIM 'Paste:=xlPasteValues', or
part of it ?

The variable 'rngPasteTo' is the cell location for the row to be pasted and
I can not figure out how to meld it into 'wksPasteTo.PasteSpecial
Paste:=xlPasteValues' without getting an error.

 

[Joel]

I see what was wrong. wksPasteTo is a worksheet object and rngPasteTo is a
range object.

originally

from
wksPasteTo.Paste rngPasteTo
to
wksPasteTo.PasteSpecial Paste:=xlPasteValues


correction

from
wksPasteTo.Paste rngPasteTo
to
rngPasteTo.PasteSpecial Paste:=xlPasteValues

 

[drewship]

Thanks!! That works for the first part of my question.

For the second part, I have tried:

With ws2
.Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy
Sheets("All_Report").Range("A3").PasteSpecial Paste:=xlPasteValues

With ws2
.Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy
Sheets("All_Report").Range("A3") PasteSpecial Paste:=xlPasteValues

With ws2
.Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy
Sheets("All_Report").Range.PasteSpecial Paste:=xlPasteValues("A3")

With ws2
.Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy
Sheets("All_Report").PasteSpecial Paste:=xlPasteValues.Range("A3")

With ws2
.Range("A3:G" & LR).SpecialCells(xlCellTypeVisible).Copy
Sheets("All_Report").Cells("A3").PasteSpecial Paste:=xlPasteValues

and probably a couple more. I have 6 report modules based on this code which
I think is bloating the spreadsheet with unnessary code copied with the data.
I would guess that it is erroring out because of the .Range() but that is
only a guess.

Thoughts on how to modify this to work?

Thanks again!!
Andrew

 

[Joel]

You didn't specify the error you are getting. I don't know wherre you are
decaring ws2, ws3, ... I suspect the sheets specified in the ranges are non
on the same page and causing an error. See my comments below and my new
code. I put the destination sheet in only one place in the code so you only
have to make one change when going from one module to a 2nd module.

Set wksPasteTo = Sheets("Closed_Requests")

Remove Line - No need to select
---------------------------------------
Sheets("Closed_Requests").Select
-----------------------------------

'ActiveSheet.Unprotect pw

Add sheet reference
------------------------------------------------
from
LR = Range("B" & Rows.Count).End(xlUp).Row
to
LR = wksPasteTo.Range("B" & Rows.Count).End(xlUp).Row

-------------------------------------------------


Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1))

move inside with and add page reference
-------------------------------------------------
Sheets("Distribution").Select
LastRow = Range("A65536").End(xlUp).Row
-------------------------------------------------

With Sheets("Distribution")
-------------------------------------------------
from
LastRow = Range("A65536").End(xlUp).Row
to
LastRow = .Range("A65536").End(xlUp).Row
------------------------------------------

For x = LastRow To 1 Step -1
If Range("B" & x).Value = "Closed" Then

add sheet reference
------------------------------------------
from
Range("B" & x).EntireRow.Copy
to
.Range("B" & x).EntireRow.Copy
------------------------------------------

Don't need with - sheet already specified in range above
With Sheets("Closed_Requests")
rngPasteTo.PasteSpecial Paste:=xlPasteValues
Set rngPasteTo = rngPasteTffset(1)
End With

remove sheet refernce - already in with
------------------------------------------
from
Sheets("Distribution").Range("B" & x).EntireRow.Delete
to
.Range("B" & x).EntireRow.Delete
------------------------------------------
End If
Next x
End With




New Code

Set wksPasteTo = Sheets("Closed_Requests")
with wksPasteTo
'ActiveSheet.Unprotect pw
LR = .Range("B" & Rows.Count).End(xlUp).Row
Set rngPasteTo = wksPasteTo.Range("A" & (LR + 1))

with Sheets("Distribution")
LastRow = .Range("A65536").End(xlUp).Row

For x = LastRow To 1 Step -1
If .Range("B" & x).Value = "Closed" Then
.Range("B" & x).EntireRow.Copy

rngPasteTo.PasteSpecial Paste:=xlPasteValues
Set rngPasteTo = rngPasteTffset(1)

.Range("B" & x).EntireRow.Delete
End If
Next x
End With

 

[drewship]

Thanks Joel!!

I took what you provided and made some modifications so it would work in a
manner I needed.

' Set wksPasteTo = Sheets("AllName1") set prior to this code block
With wksPasteTo
'ActiveSheet.Unprotect pw
LR = .Range("C" & Rows.Count).End(xlUp).Row
Set rngPasteTo = wksPasteTo.Range("A3" & (LR + 1))

With Sheets("Distribution")
'LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
LastRow = .Range("C65536").End(xlUp).Row

' For x = LastRow To 1 Step -1
For x = 3 To LastRow
' If .Range("B" & x).Value = "Closed" Then
If IsDate(.Cells(x, "C").Value) And .Cells(x, "C").Value <> ""
And .Cells(x, "C").Value >= lodate And .Cells(x, "C").Value <= hidate Then
If RowsWithNumbers Is Nothing Then
Set RowsWithNumbers = .Cells(x, "C")
Else
Set RowsWithNumbers = Union(RowsWithNumbers, .Cells(x, "C"))
End If
End If
Next
If Not RowsWithNumbers Is Nothing Then
RowsWithNumbers.EntireRow.Copy
' .Range("B" & x).EntireRow.Copy

rngPasteTo.PasteSpecial Paste:=xlPasteValues
Set rngPasteTo = rngPasteTffset(1)

End If
' Next x
End With
End With

There are 2 things that need some work. This code block in itself now pastes
the rows starting at row 32 on the temporary sheet "wksPasteTo". Still trying
to figure that out, but as a temporary workaround, I have added the following
code to delete the blank lines before the rows are copied to the actual
report:

' Delets blank rows
Cells.Select

On Error GoTo Exits:

If Selection.Rows.Count > 1 Then
Set rng = Selection
Else
Set rng = Range(Rows(1),
Rows(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row()))
End If
RwCnt = 0
For Rw = rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(rng.Rows(Rw).EntireRow)
= 0 Then
rng.Rows(Rw).EntireRow.Delete
RwCnt = RwCnt + 1
End If
Next Rw
Exits:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Although this works, it increases processing time for the report.

The last thing I need is to change the color of the status cells (column B)
based on their content. In another sheets code, I have the following block I
think could be reworked for my need:

If Not Intersect(Target, Range("B:B")) Is Nothing Then
Select Case Target.Value
Case "Complete"
If Cells(Target.Row, "D").Value <> "" Then
If MsgBox("Completion Date already exists. Update the date
to today?", vbYesNo + vbQuestion) = vbNo Then GoTo ExitPoint
End If

Cells(Target.Row, "D").Value = Date
icolor = 10
fcolor = 2
Case "In Progress"
Cells(Target.Row, "D").Value = ""
icolor = 8
Case "Items On Order"
Cells(Target.Row, "D").Value = ""
icolor = 6
Case "Researching"
Cells(Target.Row, "D").Value = ""
icolor = 3
fcolor = 2
Case "Closed"
Cells(Target.Row, "D").Value = Cells(Target.Row, "D")
icolor = 5
fcolor = 2
Case ""
icolor = 2
End Select
With Target
.Interior.ColorIndex = icolor
.Font.ColorIndex = fcolor
End With
ActiveSheet.Protect pw, UserInterfaceOnly:=True

End If

Target row D is a date field I do not need in this use of Case, so I am
looking for a way to get this to work. Is there an easier way? Thoughts??

Thanks again!!!!

 

[Joel]

the following code sets th elast line

' Set wksPasteTo = Sheets("AllName1") set prior to this code block
With wksPasteTo
'ActiveSheet.Unprotect pw
LR = .Range("C" & Rows.Count).End(xlUp).Row

It is taking the last line of data in column C. Rows.count is the last row
of the worksheet (65536). the XL commands can be duplicated using the
keyboardf

xlup - Shift-Cntl - Up Arrow
xldown - Shift-Cntl - Down Arrow
xltoleft - Shift-Cntl - left Arrow
xlright - Shift-Cntl - right Arrow


So if you select cell C100 with mouse and press the keys Shft-Cntl and then
the up arrow you will get the last row of data.


the new code you posted in the Cae Select aren't referencing a workshet.
they are using the active worksheet which I can't tell which worksheet is the
active worksheet. You should always specify a worksheet to prevent errors in
the code like the first part of the code that has a "With wksPasteTo". the
all the RANGE statement with a period in front is automatically using the
worksheet wksPasteTo. the code in the select statement has Range without the
period in front so I can't tell which is the active worksheet.

 

[drewship]

Below is the working code to change the colors of the Status cells so all
that is left for the moment is to figure out why the merged code is starting
the paste on line 32. Hopefully you or someone else can help with that. I
have tried steppiing through the code but can't see the problem:

LR = Cells(Rows.Count, "B").End(xlUp).Row
For i = 3 To LR
If Not IsEmpty(Cells(i, "B")) Then
Select Case Destination.Cells(i, "B").Value
Case "Complete"
icolor = 10
fcolor = 2
Case "In Progress"
icolor = 8
Case "Items On Order"
icolor = 6
Case "Researching"
icolor = 3
fcolor = 2
Case "Closed"
icolor = 5
fcolor = 2
Case ""
icolor = 2
' Case Else: icolor = 0
End Select

With Destination.Cells(i, "B")
.Interior.ColorIndex = icolor
.Font.ColorIndex = fcolor
End With

End If
fcolor = xlColorIndexAutomatic
Next i

Thanks!!
Andrew

 

[drewship]

I apologise for not including the complete code...I am never sure how much
code is enough...or too much. The complete code for the Case block is below
with "Sheets("All_Report").Activate" setting the active sheet...at least that
is how I understood it:

'format and review new report
Sheets("All_Report").Activate
Range("N1") = Format(lodate, "M/D/YYYY")
Range("O1") = Format(hidate, "M/D/YYYY")
Columns("C").Select
Selection.NumberFormat = "m/d/yyyy"
Columns("A:Q").Columns.AutoFit

LR = Cells(Rows.Count, "B").End(xlUp).Row
For i = 3 To LR
If Not IsEmpty(Cells(i, "B")) Then
Select Case Destination.Cells(i, "B").Value
Case "Complete"
icolor = 10
fcolor = 2
Case "In Progress"
icolor = 8
Case "Items On Order"
icolor = 6
Case "Researching"
icolor = 3
fcolor = 2
Case "Closed"
icolor = 5
fcolor = 2
Case ""
icolor = 2
End Select

With Destination.Cells(i, "B")
.Interior.ColorIndex = icolor
.Font.ColorIndex = fcolor
End With

End If
fcolor = xlColorIndexAutomatic
Next i

Range("A3").Select


I am looking at the rest of your reply....

 

[drewship]

Ok...not sure why removing the header lines (only 2 lines) made a difference,
but after I commented out the Delete Blank Rows code block, it works
correctly, and quickly.

Thank you very much for your help!! Merging my code with yours will make it
easier to make changes and additions in the future and hopefully reduce
spreadsheet bloat due to unneeded code in the reports.

Andrew

 

[Joel]

I re-wrote the code the way I usually write my code. I can see you use
recorded to get some of your code. Inever use the recorded code directly. I
always modify the recorded code. some time it is quicker for me to use the
recorded but I I avoi using the select method in my macros unless excel only
except the method with the select.

Looking at the modified code I found your problem. Half you code is working
with one worksheet and the other half with a different worksheet. You need
to be using only one worksheet in this macro.

with Sheets("All_Report")
.Range("N1") = Format(lodate, "M/D/YYYY")
.Range("O1") = Format(hidate, "M/D/YYYY")
.Columns("C").NumberFormat = "m/d/yyyy"
.Columns("A:Q").Columns.AutoFit

LR = .Cells(Rows.Count, "B").End(xlUp).Row
For i = 3 To LR
If Not IsEmpty(.Cells(i, "B")) Then
Select Case Destination.Cells(i, "B").Value
Case "Complete"
icolor = 10
fcolor = 2
Case "In Progress"
icolor = 8
Case "Items On Order"
icolor = 6
Case "Researching"
icolor = 3
fcolor = 2
Case "Closed"
icolor = 5
fcolor = 2
Case ""
icolor = 2
End Select

With Destination.Cells(i, "B")
.Interior.ColorIndex = icolor
.Font.ColorIndex = fcolor
End With

End If
fcolor = xlColorIndexAutomatic
Next i

Range("A3").Select
end with

 

[drewship]

I am not very good writing the code myself so I use the wizaeds to get me
started then try to modify them for my purposes. In this case I think I
confused myself a bit. Thanks for all your help!! The code is perfect!!

Andrew