PDA

View Full Version : Solved: copy rows from worksheet to worksheet



bonesmcgraw
03-16-2008, 03:04 AM
I have a few different lists all in one worksheet. For example my first list has a label in a1 with a name in it (lets call it list 1) then in row a2-I2 are the headings then in rows 3-wherever (depends on how many rows are needed which will change all the time) is all the information. Then lets say that in a20 is the start of list 2. so a20 will have the name (lets call it list 2) and a21-I21 are the headings and rows 22-wherever is all the information and this continues through 10 different lists.

Right now I have it setup so when I put the word yes in column I it deletes that row and copies it to the next available row on worksheet 2.

What I'm wondering is is there a way that when it moves the row from worksheet 1 to worksheet 2 it will put it in the same list format. So if a row in list 2 has the word yes put into column I it will move it to worksheet 2 list 2 in the next available row and to do this for every different list.

Thanks

Bob Phillips
03-16-2008, 04:16 AM
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "I:I" '<== change to suit
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target

If .Value = "Yes" Then

If Me.Cells(.Row, "A").Value <> "" And Application.CountA(Me.Cells(.Row, "A").Resize(, 9)) = 2 Then

If Application.CountA(Me.Cells(.Row + 1, "A").Resize(, 9)) = 9 Then

LastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
i = .Row
Do

i = i + 1
Loop Until (Me.Cells(i, "A").Value <> "" And _
Application.CountA(Me.Cells(i, "A").Resize(, 9)) = 2 And _
Application.CountA(Me.Cells(i + 1, "A").Resize(, 9)) = 9) Or _
i >= LastRow

NextRow = Worksheets("Sheet2").Cells(Worksheets("Sheet2").Rows.Count, "A").End(xlUp).Row + 1
Me.Rows(.Row).Resize(i - .Row).Copy Worksheets("Sheet2").Rows(NextRow)
Me.Rows(.Row).Resize(i - .Row).Delete
End If
End If
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


This is worksheet event code, which means that it needs to be
placed in the appropriate worksheet code module, not a standard
code module. To do this, right-click on the sheet tab, select
the View Code option from the menu, and paste the code in.

bonesmcgraw
03-17-2008, 09:14 AM
I pasted the code in and it isn't doing anything at all. Its like there isn't any code. I've saved it closed excel then reopened everything and nothing.

Any ideas?

Bob Phillips
03-17-2008, 11:05 AM
Did you paste it where directed?

bonesmcgraw
03-17-2008, 11:25 AM
I had the workbook book opened. right clicked on sheet 1 then copied the code into the box for the code.

lucas
03-17-2008, 11:47 AM
I'm going to say this for Bob so he doesn't have to......

could you please post the workbook you are working on so we can see what you have and we don't have to re-create it.

hit post reply at the bottom left of the last post and then scroll down until you find a button marked "manage attachements"

bonesmcgraw
03-17-2008, 11:56 AM
this is the code that i pasted:

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "J:J" '<== change to suit
Dim LastRow As Long
Dim NextRow As Long
Dim i As Long

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target

If .Value = "yes" Then

If Me.Cells(.Row, "A").Value <> "" And Application.CountA(Me.Cells(.Row, "A").Resize(, 10)) = 2 Then

If Application.CountA(Me.Cells(.Row + 1, "A").Resize(, 10)) = 10 Then

LastRow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
i = .Row
Do

i = i + 1
Loop Until (Me.Cells(i, "A").Value <> "" And _
Application.CountA(Me.Cells(i, "A").Resize(, 10)) = 2 And _
Application.CountA(Me.Cells(i + 1, "A").Resize(, 10)) = 10) Or _
i >= LastRow

NextRow = Worksheets("Complete").Cells(Worksheets("Complete").Rows.Count, "A").End(xlUp).Row + 1
Me.Rows(.Row).Resize(i - .Row).Copy Worksheets("Complete").Rows(NextRow)
Me.Rows(.Row).Resize(i - .Row).Delete
End If
End If
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


I changed it from column I to column J and I assumed all the 9's referenced column I so I switched them to 10. I did try it both with the 9's and the 10's. Again this is copied into worksheet 1 which is renamed to active. and my worksheet 2 is renamed to Complete.

bonesmcgraw
03-17-2008, 12:40 PM
This is the workbook i'm trying to install it on right now. this is just so i can test it and make sure this is what i want. i will post the actual workbook in the next post maybe you can help to actually integrate it into the actual workbook i'm going to use. either way would be great.

bonesmcgraw
03-17-2008, 12:41 PM
this is ultimately the workbook i want it to go into.

Bob Phillips
03-17-2008, 01:04 PM
I'm confused now as tow what we should copy. Can you explain what and where you will act and what and where should then be copied (a specific example not a generic explanation)

bonesmcgraw
03-17-2008, 01:29 PM
the workbook inst is the one i would really want to use it in. I want to set up the complete sheet (sheet2) the same way as in the template workbook complete sheet is. So if in column J13 when i type yes it will delete from the active worksheet and copy into the Completed worksheet. In the Completed worksheet it will have the lists setup just like on the Active worksheet. i named each list so when it is copied to the completed worksheet it will be copied into the same list with the same name. so it would be the clopay northwest 83 list.

bonesmcgraw
03-17-2008, 01:31 PM
also once it is copied over to the completed worksheet i want it to delete automatically after 3 months from the date finished column. its setup that once i type yes into the j column it places the current date into the I column. then 3 months from that date I want it to delete from the complete worksheet

bonesmcgraw
03-17-2008, 01:38 PM
This is the workbooks combined so you don't have to go in between the 2 different books.

tstav
03-17-2008, 03:32 PM
As for the deleting of rows after 3 months I thought we covered this in your other thread which is now entitled "Solved: Resolved: Delete Row after 3 months".

As for the transfering of data to the "Complete" Sheet, I saw your combined workbook and you can try this:
Private Sub Worksheet_Change(ByVal Target As Range)
'---------------------------------------------------------------
'Type 'yes' in column "J" to copy row to Sheet "Complete"
'---------------------------------------------------------------
Dim thisRow As Long, lastRow As Long
Dim cell As Range, Sht As Worksheet
lastRow = Me.UsedRange.Row + Me.UsedRange.Rows.Count - 1
Set Sht = Worksheets("Complete")
On Error GoTo ErrorHandler
Application.EnableEvents = False

'Avoid Title and Header rows
If Not Intersect(Target, Columns("J")) Is Nothing And _
(WorksheetFunction.CountA(Me.Cells(Target.Row, 1).Resize(, 10)) <> 1 And _
WorksheetFunction.CountA(Me.Cells(Target.Row - 1, 1).Resize(, 10)) <> 1) Then
If UCase(Target.Value) = "YES" Then
Target.Offset(0, -1).Value = Date
'Find the row of the title above the "yes" row
thisRow = Target.Row
Do Until WorksheetFunction.CountA(Range(Cells(thisRow, 1), Cells(thisRow, 2))) = 1
thisRow = thisRow - 1
Loop
With Sht
'Find the same title on the second worksheet
Set cell = .Columns("A").Find( _
What:=Cells(thisRow, 1).Value, After:=.Cells(.Rows.Count, 1), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not cell Is Nothing Then
'Paste the data from Sheet1
.Rows(cell.Row + 2).Insert
cell.Offset(2, 0).Resize(, 10).Value = Cells(Target.Row, 1).Resize(, 10).Value
'Delete row from Sheet1
'Rows(Target.Row).Delete
Else
MsgBox "List title not found on <Complete>", , "Error"
End If
End With
End If
End If
ErrorHandler:
Application.EnableEvents = True
End Sub

bonesmcgraw
03-17-2008, 04:13 PM
thanks for the help everybody. I will try this out first thing tomorrow when I get back to work. I will let you guys know if it worked or not.

tstav yes the deleting rows after 3 months was been solved. I wasn't thinking straight. I was thinking this code would go in the same worksheet (complete) as the other code(even though I was pasting it in the correct sheet(active). All the code that I already have in the active worksheet to change the color of the cells can be left alone correct? How would I combine the 2 to work together?

Again thanks for all the help.

bonesmcgraw
03-18-2008, 08:05 AM
Almost there. The code is working great. The last thing I can't figure out is when it is copying the row over from my active worksheet to my complete worksheet when it copies it into the row it is copying the formating of my headings. My heading are bold, center, and underline. I just want them to be normal text with no formating.

I've attached a copy of the workbook so you can see what i'm talking about. if you look on the Complete worksheet you will see what i'm talking about.

Thanks

tstav
03-18-2008, 08:42 AM
Change the following code line, where the copy/paste takes place.
Cells(Target.Row, 1).Resize(, 10).Copy cell.Offset(2, 0).Resize(, 10)
'cell.Offset(2, 0).Resize(, 10).Value = Cells(Target.Row, 1).Resize(, 10).Value

bonesmcgraw
03-18-2008, 09:23 AM
Ok so the code was working this morning with out a problem exept the cell format. I saved everything reopened it and everything was working. Now I went to reopen it and copy in the new code snipit and when I click the save button excel tells me document not saved. I've opened other workbooks and they are saving without a problem.

Any ideas as to what is creating this. the workbook is exactly the same as the attached one above.

Thanks

tstav
03-18-2008, 09:42 AM
I copied rows over and I saved just fine.
Oh, as for the formatting of the copied rows, I noticed you use colors in the records of the "Active" sheet. The color is copied over to the "Complete" sheet, along with the data. You'll have to do a little de-coloring yourself (I noticed you've already placed some code there...)

I'm sure it's nothing and you'll get around it. Play with it a little, maybe close all files and applications, maybe reboot system.

bonesmcgraw
03-18-2008, 10:33 AM
Again thank you so much for the help. Apparently we had a network glitch that wasn't allowing anybody on any computer to save.

Everything seems to be working perfectly now.

Again thanks for all the help