PDA

View Full Version : Copy row into Specified ws.



noobie
11-22-2006, 12:34 AM
Hello,
I just create a thread not long ago. I want to post this there. But I already marked it solved. So pls look at the link below for a better understanding! sorry for the inconvenience!

http://vbaexpress.com/forum/showthread.php?t=10254

The problem is regarding the search for non blank rows. Some of the rows may not be filled up entirely.
Is it possible to
- search for rows which is filled up till column K as the last row.
- but copy the whole row to Sheet 2 till column K?

mdmackillop
11-22-2006, 12:46 AM
Try

Sub Rws()
For Each rw In ActiveSheet.UsedRange.Rows
If Cells(rw.Row, Columns.Count).End(xlToLeft).Column < 12 Then
Cells(rw.Row, 1).Resize(, 13).Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
Next
End Sub

noobie
11-22-2006, 01:13 AM
Hi. Many thanks for your response!

I tried your macro. But it did not copy anything.Maybe i did not explain my situation right. Anyway, in order for u to get a better understanding, I attached a workbook for your reference. Sheet 2 is where the consolidation or summary takes place.

Many thanks again!!

Charlize
11-22-2006, 02:13 AM
Do you mean that every column of the row must be filled in before to copy something ? And if you copied the row, will it be deleted ?

Charlize

noobie
11-22-2006, 02:24 AM
Hi, Sorry for the confusion. Here's to answer to your enquiry!

no. Not every column must be filled before the row is copied. The guideline is once column K is filled, the whole row ( from column A to column K) must be copied. Within this row, they may be blanks.

No. The rows in sheet 1 will never be deleted. Sheet 2 will only act as a consolidation sheet.

Many thanks in advance!!

Charlize
11-22-2006, 03:52 AM
What about this one. A must always be filled in.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lrow As Long
'look at changes in range K2:K35
If Not Intersect(Target, Range("K2:K35")) Is Nothing Then
lrow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
'when not using headings check if something in else row = 1
If Sheets(2).Range("A1").Value <> "" Then
lrow = lrow + 1
Range("A" & Target.Row & ":K" & Target.Row).Copy Sheets(2).Range("A" & lrow)
Else
Range("A" & Target.Row & ":K" & Target.Row).Copy Sheets(2).Range("A" & lrow)
End If
End If
End Sub
This presumes that once column K is filled in, it will never be changed again in sheet1 otherwise it will be copied a second time.
Charlize

noobie
11-22-2006, 06:07 PM
Thanks! That was what I needed. But to simplify matters further, it is possible
-only paste values not formulas?

Many thanks for your patience.

lucas
11-22-2006, 11:08 PM
noobie,
there are no formula's in the file you attached to post #3
but if you were going to add them at some time you could just run a bit of code to remove all formula's and replace them with values on sheet 2
you will have to make sheet 2 active first....
'Remove all formula's from the activesheet
Sub removeFormulas()
With Cells
.Select
.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
Range("A1").Select
End Sub

noobie
11-22-2006, 11:37 PM
I tried your suggestion. However I would like to apply worksheet change to enable automation without the use of a button.

The problem is : I can't have two worksheet changes in 1 worksheet. right now, I'm having a sorting macro using w/s change. Any suggestion on how i can combine them together, with the removing of forumals macro operating first.



'Remove all formula's from the activesheet
Sub removeFormulas()
With Cells
.Select
.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
Range("A2").Select
End Sub

' sorting formula

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

'Check that Col B changed
If Not Intersect(Target, Range("B:B")) Is Nothing Then

'Sort all rows A1 to changed cell. Key1 = Col A, Key2 = Col B
Range("A2:B" & Target.Row).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
Application.ScreenUpdating = True
End Sub








Thanks so much!

mdmackillop
11-23-2006, 01:47 AM
Hi Noobie,
Think about it! You can only have one worksheet change event at a time. What you can do though is run multiple codes as a result of the change.
eg

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Call Macro1
Call Macro2
Call Macro3
'etc.
Application.EnableEvents = True
End Sub



The other thing you can do is to respond to different changes

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents= False
'Check that Col B changed
If Not Intersect(Target, Range("B:B")) Is Nothing Then
Call Macro1
End If
'Check that Col C changed
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Call Macro2
End If
'Check that Col D changed
If Not Intersect(Target, Range("D:D")) Is Nothing Then
Call Macro3
End If
Application.EnableEvents= True
End Sub



or any combination of the two.
Regards
MD

Charlize
11-23-2006, 02:09 AM
This is for copying the values of the formulas and not the formulas.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lrow As Long
'look at changes in range K2:K35
If Not Intersect(Target, Range("K2:K35")) Is Nothing Then
lrow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row
'when not using headings check if something in else row = 1
If Sheets(2).Range("A1").Value <> "" Then
lrow = lrow + 1
Range("A" & Target.Row & ":K" & Target.Row).Copy
Sheets(2).Range("A" & lrow).PasteSpecial _
Paste:=xlPasteValues
Else
Range("A" & Target.Row & ":K" & Target.Row).Copy
Sheets(2).Range("A" & lrow & ":K" & lrow).PasteSpecial _
Paste:=xlPasteValues
End If
End If
End Sub
Charlize

noobie
11-23-2006, 02:13 AM
hi! I nv thought of that. Thanks for enlighting me.

Thus, I applied what you have taught me. and got this




Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Call macro1
Call Macro2

Application.ScreenUpdating = True
End Sub

'Remove all formula's from the activesheet
Sub macro1()
With Cells
.Select
.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
Range("A2").Select
End Sub

' sorting formula

Sub Macro2()


'Check that Col B changed
If Not Intersect(Target, Range("B:B")) Is Nothing Then

'Sort all rows A1 to changed cell. Key1 = Col A, Key2 = Col B
Range("A2:B" & Target.Row).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If

End Sub




A error occured. Selection method of range class failed.
I'm so sorry for taking up all of your time. But I'm really new at this. I'm most willing to learn.

Thanks once again! :bow:

noobie
11-23-2006, 02:25 AM
Thanks Charlize and mdmackillop for your prompt and consistent reply.
I've been working out on Charlize's code and it seems to be working. however, I would want to try it out further. so i'll mark this solved much later.

Thanks for both of your suggestions! I sure have benefit alot. :thumb

Best regards,

noobie

mdmackillop
11-23-2006, 06:31 AM
Apologies to start with. I copied ScreenUpdating instead of EnableEvents into my code in error.
Re your code
Macro1 - you need to provide a location for Cells, in this case ActiveSheet.Cells
Macro2 - this is going to do sometking with a range called Target. In this code, you need to pass the variable to the macro. You can see how this is done in the revised code. Read about this in the Help files, it's a very common requirement.


Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Call Macro1
Call Macro2(Target)
Application.EnableEvents = True
End Sub
'Remove all formula's from the activesheet
Sub Macro1()
With ActiveSheet.Cells
.Select
.Copy
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End With
Range("A2").Select
End Sub

' sorting formula
Sub Macro2(Target As Range)
'Check that Col B changed
If Not Intersect(Target, Range("B:B")) Is Nothing Then
'Sort all rows A1 to changed cell. Key1 = Col A, Key2 = Col B
Range("A2:B" & Target.Row).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub