Moving Data Help

[wamp]

I am very new to the excel world.
I have been tasked to come up with a sheet in excel for logging parts in and out. The problem you ask, well, I can create a sheet just fine, but what I need is more difficult.

I need something to happen when data is entered into the final column. I need the entire row moved to another sheet (database) and that original row to disappear..

Can this even be done?

 

[Yesuslave]

Do you want the data to move once the column is completed, once any data at all is put into it, or on a controlled event, like a button push?

 

[wamp]

Well, since the data from the first sheet will be moved at diffrent times and not in order, I would think that the completed data would be the best option.

I have the sheet made up already. I put a column at the end which indicates that the row is done.

 

[Yesuslave]

Well, before I pop up some code for you, I wonder...

Do you want a button on the spreadsheet that will do something like "Move all completed rows to another workbook"?

Or

Do you want the row to automatically move once the "completed" column indicates completion?

The first one is easy, the second one...I'm not sure.

Josh

 

[wamp]

The first option I think would be best.. I like that idea. I am tyring to learn all this stuff and looking on this site for books and stuff. It is very interasting stuff!

 

[wamp]

P.S. Thanks for your help so far. I really do appreciate it!

 

[Yesuslave]

Ok, you can put this macro in your Personal.xls and then either create a button on your toolbar, or run it from your Tools->Macros menu. I couldn't get it to work from a button on the sheet, however.

Sub DeleteRowsWacky()

Dim intRow As Integer
Sheets("Stuff").Select

Range("a1").Select 'This is assuming that the rows will always have data in Column A
Selection.End(xlDown).Select
intEndRow = ActiveCell.Row + 1

Range("D1").Select 'Assuming column D is the column that contains the marker as to
'whether or not a row is complete

'THe code here goes down until it reaches the last row found and stored in intEndRow
'If it finds data, it will select the whole row, cut it, then select the worksheet "Paste"
'and paste it in the first availible row. it will then return to the first page "Stuff"
'and resume the search.

Do Until ActiveCell.Row = intEndRow

If ActiveCell.Text = "x" Then 'assuming that "x" is the marker you use to mark a row complete

intResumeRow = ActiveCell.Row
Range(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Cut
Sheets("Paste").Select
Range("A1").Select
Do Until ActiveCell.Text = ""
ActiveCell.Offset(1, 0).Select
Loop

ActiveSheet.Paste
Sheets("Stuff").Select
Range(intResumeRow & ":" & intResumeRow).Delete
Range("D" & intResumeRow).Select
Else
ActiveCell.Offset(1, 0).Select
End If



Loop


End Sub

 

[north19701]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column > 4 Then Exit Sub
RowNum = Target.Row
If Application.WorksheetFunction.CountBlank(Range("a" & RowNum & ":d" & RowNum)) > 0 Then Exit Sub
Target.EntireRow.Copy Destination:=Sheets("PartsOut").Range("a" & Sheets("PartsOut").UsedRange.Rows.Count + 1)
Target.EntireRow.Delete
End Sub

Here is an alternative way that uses a worksheet event. It would need to go in the worksheet module. I also set it up for 4 columns - A through D, so you may need to adjust the target.column count. also the destination sheet as well to match where the data should go. this is also assuming a header row on the PartsOut Sheet. Basically, as soon as all the fields for that row are completed, it will take that information and paste it over the the PartsOut sheet automatically.

 

[wamp]

It Works!!! I had to change a few things, but it works! Thank you for all your help!

Here is the only problem I have. Row 1 is used as the description row and I do not want it to be affected. BUT, if you accidently click in that row, it sends it too. I need it to stay where it is.

Here is the exact Code I used...

Private Sub Worksheet_change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column > 7 Then Exit Sub
RowNum = Target.Row
If Application.WorksheetFunction.CountBlank(Range("a" & RowNum & ":g" & RowNum)) > 0 Then Exit Sub
Target.EntireRow.Copy Destination:=Sheets("Database").Range("a" & Sheets("Database").UsedRange.Rows.Count + 1)
Target.EntireRow.Delete
End Sub


It works fine except the row 1 problem... Anyone know how to solve this one..

 

[north19701]

Private Sub Worksheet_change(ByVal Target As Range) 
If Target.Count > 1 Then Exit Sub 
If Target.Column > 7 Then Exit Sub
If Target.Row = 1 Then Exit Sub ' add this line
RowNum = Target.Row 
If Application.WorksheetFunction.CountBlank(Range("a" & RowNum & ":g" & RowNum)) > 0 Then Exit Sub 
Target.EntireRow.Copy Destination:=Sheets("Database").Range("a" & Sheets("Database").UsedRange.Rows.Count + 1) 
Target.EntireRow.Delete 
End Sub