Previous Topic Next Topic

Cut &past data from sheet to shhet depending

Solved/Closed
Sibsanne - Nov 14, 2011 at 03:52 AM
 Sibsanne - Dec 20, 2011 at 05:49 AM
Dears,

I'm a novice in M* Excel.
Still, for day to day followup purpose, I need a macro and/or appropriate solution that does the following:
For example, I would have 4 sheets, each corresponding to a status 1 to 4.
On sheet one, each row would contain data from A to H column, where H would contain a status I pick from a drop down list.
Depending on the status I pick, the data should be cut and past to the corresponding sheet without overwriting eventually existing data.

Am I clear?


Thx in advance for your time

Best regards
Related:

7 responses

Answer 1 / 7
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Nov 14, 2011 at 09:35 AM
Hi Sibsanne,

So you have a master sheet with dropdown lists in column H which can only be 1, 2, 3 or 4.
When a number is selected (from dropdown), the row will be cut/paste to the sheet with the corresponding number. These sheets are called "1", "2", "3" and "4".

Is this correct?

Best regards,
Trowa
0
Answer 2 / 7
sibsanne
Nov 15, 2011 at 01:12 AM
Hi TrowaD, thx for asking.

To make it simple I used 1,2,3 & 4 as status value, but those will actually be text value like: "PO Request done" - "PO received" - "Blanco PO send" etc. to the last status "Done"
There could also be more than 4 status up to a maximum of 11 actually.

Thx
Best regards
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Nov 15, 2011 at 09:35 AM
Hi Sibsanne,

To use the following code, right-click on your master sheets tab and select view code.
Visual Basic will open, now paste the code in the big white field.

I changed the numbers into letters because VB addresses them differently.

One final thing. Codes cannot be reversed using the blue arrows. So it's wise to make a backup first or at least save your file before using the code. Then when you file gets messed up you can reload your file.

Here is the code: 
Private Sub Worksheet_Change(ByVal Target As Range)
'The code will only work when a change is made to column H.
If Intersect(Target, Columns("H:H")) Is Nothing Then Exit Sub

'If the value changed into A then cut entire row and paste to sheet A into the first available row.
If ActiveCell = "A" Then Target.EntireRow.Cut Destination:=Sheets("A").Rows(Rows.Count).End(xlUp).Offset(1, 0)
'Same goes for the value B.
If ActiveCell = "B" Then Target.EntireRow.Cut Destination:=Sheets("B").Rows(Rows.Count).End(xlUp).Offset(1, 0)
'Add more statements to complete the code.

End Sub


Best regards,
Trowa
0
Answer 3 / 7
sibsanne
Nov 15, 2011 at 12:44 PM
TrowaD,

I tried it and it works great !!

Thx a lot for your time

Best regards,

Sib
0
sibsanne
Dec 2, 2011 at 03:19 AM
Hi trowad,

Your code is doing his job!

Now that my DB grows and different sheets get filled.
I do see the need for an added function.
When I cut a row to another sheet, it leaves a blank row.
Is it possible to add a line of code that would delete the blank row after it got cut to the new sheet?
So that I have not to do it manually?

Thx.
0
Answer 4 / 7
sibsanne
Dec 2, 2011 at 03:20 AM
(is submit reply the same as add comment...?)
(I prefer reply tot topic, to make sure you get it)

Hi trowad,

Your code is doing his job!

Now that my DB grows and different sheets get filled.
I do see the need for an added function.
When I cut a row to another sheet, it leaves a blank row.
Is it possible to add a line of code that would delete the blank row after it got cut to the new sheet?
So that I have not to do it manually?

Thx.
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Dec 8, 2011 at 09:11 AM
Sorry for the late response Sibsanne, but here is the adjusted code: 

Private Sub Worksheet_Change(ByVal target As Range)
'The code will only work when a change is made to column H.
If Intersect(target, Columns("H:H")) Is Nothing Then Exit Sub

'If the value changed into A then cut entire row and paste to sheet A into the first available row.
If ActiveCell = "A" Then
target.EntireRow.Copy Destination:=Sheets("A").Rows(Rows.Count).End(xlUp).Offset(1, 0)
target.EntireRow.Delete
End If
'Same goes for the value B.
If ActiveCell = "B" Then
target.EntireRow.Copy Destination:=Sheets("B").Rows(Rows.Count).End(xlUp).Offset(1, 0)
target.EntireRow.Delete
End If
'Add more statements to complete the code.

End Sub


Hopefully it will still be usefull.

Best regards,
Trowa
0

Didn't find the answer you are looking for?

Ask a question
Answer 5 / 7
sibsanne
Dec 8, 2011 at 12:53 PM
Don't know what to say TrowaD !!

Implemented it.
Tested it.
It worked.
It's doing what I need...


Supaaaa ;o)

Thanks a lot, your help is much appreciated.

If you want to see the result.
I can send it to you.
I have been able to do a lot, just by asking on the web.
Incredible.
I even have a little search engine.
Terrific.
0
Answer 6 / 7
Sibsanne
Dec 15, 2011 at 09:11 AM
Hi Trowad,

Maybe you are able to help with this.

I found the code below on the net.
It's a search macro that search all sheets and displays the results.
It works fine. I have one issue whit it.
Some of my data is redundant, and can be repeated several time in one and the same row.
So this search engine give me the same row several times.
I was wondering if it was possible to have one result per row only.

It could also be done this way.
My data is repeated only after the column P.
So if this search engine could search all sheets from column A to P only, it would do the trick also. 

Public Sub FindTextFromCell()
'Run from standard module, like: Module1.

Dim ws As Worksheet, Found As Range, rngNm As String
Dim myText As String, FirstAddress As String, thisLoc As String
Dim AddressStr As String, foundNum As Integer

myText = Sheets("SEARCH").Range("D4").Value

If myText = "" Then Exit Sub

For Each ws In ThisWorkbook.Worksheets
With ws
Set Found = .UsedRange.Find(What:=myText, LookIn:=xlValues, MatchCase:=False)

If Not Found Is Nothing Then
FirstAddress = Found.Address
Do

If .Name = "SEARCH" Then GoTo myNext
If .Name <> "SEARCH" Then _
Found.EntireRow.Copy _
Destination:=Worksheets("SEARCH").Range("A65536").End(xlUp).Offset(1, 0)

Set Found = .UsedRange.FindNext(Found)

Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
End With

myNext:
Next ws
End Sub


thx
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Dec 15, 2011 at 10:29 AM
Hi Sibsanne,

It's easier for me to write my own code.

I used column A to determine how many rows to loop through and on sheet "SEARCH" to know which row to copy to. In other words I assumed that when a row contains data then column A of that row always contains data as well.

Note that I have given you a second option to input the search value.
Putting an ' (single quote) in front of a code line makes it green and will be skipped when the code is run. Use this or just delete the code line to choose between option 1 or 2.

Here is the code: 
Sub test()
Dim x, y, lRow As Integer
Dim ws As Worksheet

'Option 1: Enter the search value in D4 of sheet "SEARCH".
myText = Sheets("SEARCH").Range("D4").Value

'Option 2: Enter the search value using an inputbox.
'myText = InputBox("Please input the value to search for:")

For Each ws In Worksheets
If ws.Name = "SEARCH" Then GoTo Nxt
ws.Select
lRow = ws.Range("A" & Rows.Count).End(xlUp).Row
x = 1

    Do
    y = 1
Do
If Cells(x, y).Value = myText Then
Rows(x).EntireRow.Copy Destination:=Sheets("SEARCH").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
y = 17
End If
y = y + 1
Loop Until y > 16
    x = x + 1
    Loop Until x > lRow
Nxt:
Next ws

End Sub


Hope you like this little search engine :-)

Best regards,
Trowa
0
Answer 7 / 7
sibsanne
Dec 15, 2011 at 02:42 PM
Thx Trowad,

It seems to work.

At some point I got an error at line 13 
If Cells(x, y).Value = myText Then

But I suppressed the sheet which I was testing with and it stopped.

Also I added * at the end of your code.
*
Sheets("SEARCH").Select

(yes I learned to record my action ;o))
Otherwise you get on the last sheet of the workbook instead of the result.

It looks to be case sensitive. Is it possible to change this?

Thx for your time.
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Dec 19, 2011 at 09:21 AM
Hi Sibsanne,

Great to see you are getting the hang of this.

To make the code non case sensitive use this line above the "Sub test()" line: 
Option Compare Text
code will look like: 
Option Compare Text
Sub test()
Dim x, y, lRow As Integer
etc...


Best regards,
Trowa
0
Sibsanne
Dec 20, 2011 at 05:49 AM
Thx Trowad!!!

I have all I need now!!

I even managed (by myself !!) to get a VBA working that generate a ready to send email, template filled with data from the excel file, to field, cc field etc. and also with attachment retrieved on network drive... All this in one click based on active cell. This save me a lot of wrist work!!!
I mixed two VBA scripts I found on the net. and after 3 days of seeking frustration, by miracle it worked. (sometime I blocked on things like & instead of = or no = needed..)
That vba languages is very weird one... but ... IT works ;o)

I'm on holiday as from tomorrow, back in january.

I wish you a good new year 2012.
0

Similar discussions

AMD data change update new data to DMI
Luis -
dwebb -

1 response
Unlock safe folder without losing any data
Mintu -
HelpiOS -

1 response