Set rng for Column A only (ignores other columns)

[Aria]

Hello,
I'm trying to loop this: copy each cell in column A that is selected,
paste to Sheet2's A1, print. Loop until all selected cells are copied
to Sheet2.

How do u improve this code so that even if other users mistakenly
highlight the entire row, the rng = selection.cells would only be the
data within column A and not the entire row?

Set rng = Selection.Cells

For Each cell In rng
cell.Copy
Sheets("Sheet2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Next cell

Thanks!
Aria

*** Sent via Developersdex http://www.developersdex.com ***

 

[Dave Peterson]

Set Rng = nothing
on error resume next
Set rng = intersect(Selection.Cells, activesheet.range("A:A"))
on error goto0

if rng is nothing then
msgbox "nothing in column A selected"
exit sub '???
end if

with worksheets("Sheet2")
for each cell in rng.cells
cell.Copy _
destination:=.Range("A1")
with .range("a1")
.value = .value
end with
.printout copies:=1, collate:=true
next cell
end with

=====
If all you needed was the value copied to A1 of Sheet2, you could use:

with worksheets("Sheet2")
for each cell in rng.cells
.range("a1").value = cell.value
.printout copies:=1, collate:=true
next cell
end with

 

[Aria]

Hi Dave,
I've taken your solution...I need your modification help please.

Could the msgbox be replaced with...If any of the user's selection
(users would CTRL and pick their rows) within column A is blank, then
don't copy it and move to the next selection. Currently, this code
copies the blank space.

If a user selects any cells along a row (but doesn't highlight column
A), how do i set rng to still point back to column A? This is rather
handy so I don't have to remind users to always highlight the entire row
or always select within column A.

Thanks so much,
Aria


Set rng = Nothing
On Error Resume Next
Set rng = Intersect(Selection.Cells, ActiveSheet.Range("A:A"))
On Error GoTo 0

If rng Is Nothing Then
MsgBox "nothing in column A selected"
Exit Sub '???
End If

With Worksheets("sheet2")
For Each cell In rng.Cells
.Range("A1").Value = cell.Value
.PrintOut copies:=1, collate:=True
Next cell
End With



*** Sent via Developersdex http://www.developersdex.com ***

 

[Dave Peterson]

Set rng = Nothing
On Error Resume Next
Set rng = Intersect(Selection.entirerow, ActiveSheet.Range("A:A"))
On Error GoTo 0

If rng Is Nothing Then
'this shouldn't happen--if a cell is selected, then extending that
'selection to the entire row will include column A.
MsgBox "nothing in column A selected"
Exit Sub '???
End If

With Worksheets("sheet2")
For Each cell In rng.Cells
if trim(cell.value) = "" then
'skip it
else
.Range("A1").Value = cell.Value
.PrintOut copies:=1, collate:=True
end if
Next cell
End With

 

[Aria]

Dave,
This is absolutely amazing! You're a godsend. This is exactly what I
neeeded. I owe you lots.

Aria


*** Sent via Developersdex http://www.developersdex.com ***