Move rows in excel to different worksheets

June 21, 2011 at 09:46:54
Specs: Windows 7
First off, great site with a lot of great solutions...thank you!

OK, I have an excel sheet I am using for inventory. I have been leaving everything on one sheet and using a filter to remove data that is no longer immediately relevant, but I would prefer to have my rows move to another sheet when they attain a certain status.
ie:
A piece of inventory arrives. Its status will always be one of 3 options (I have been signifying this in a column headed "R/W/?" All inventory starts as a "?" and all "?"s will eventually become "R" or "W".
I would like to separate these 3 options into 3 sheets titled "Pending" (?) "Retail" (R) and "Wholesale" (W)

I have somewhat gotten this with the following formula:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'stop anything re-triggering this event macro
Application.EnableEvents = False

On Error GoTo ErrHnd

'test if changed cell is in column I (col. 9) and it contains W (or w)
If Target.Column = 9 And UCase(Target.Text) = "W" Then
Dim rngCell As Range
Dim rngDest As Range
Dim strRowAddr As String

'save target row address
strRowAddr = Target.Address

'find next row in destination worksheet
Set rngDest = Worksheets("WHOLESALE"). _
Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)

'cut the source row & paste to destination
Target.EntireRow.Cut Destination:=rngDest
'remove the cut/copy range marquee
Application.CutCopyMode = False
'delete the source row
Worksheets("RETAIL").Range(strRowAddr).EntireRow.Delete _
Shift:=xlUp
End If
Application.EnableEvents = True
Exit Sub

'error handler
ErrHnd:
Err.Clear
Application.EnableEvents = True
End Sub


This formula (and a similar one with reverse values on the "WHOLESALE" sheet) allows me to take inventory from my main sheet that I've been using and send "W" values to the WHOLESALE sheet and if there is a change in status (from W to R) to send it back to the main sheet. This is no problem. But...

Once inventory is determined to be W or R, it then eventually gets sold and I would like to have the rows move to 2 other sheets for "WHOLESALE SOLD" and "RETAIL SOLD"

I tried to re-use the formula, changing it a bit to affect a different column titled "Status" which will have values of 'available' or 'sold' but I get an error on this line"
Private Sub Worksheet_Change(ByVal Target As Range)
saying that Worksheet_Change is redundant.

Sorry so long winded, but wanted to ensure I got all the information. Any help would be amazing!


See More: Move rows in excel to different worksheets

Report •

#1
June 21, 2011 at 12:01:19
First, let's get the terminology correct to avoid any confusion.

What you posted is a "macro", not a formula. A formula (or function) is placed in an Excel cell, while a macro is placed in a module within the VBA editor.

Second, before you post any more code, please click on the blue sentence at the end of this post and review the instructions on how to post data and code in this forum in a way that makes it easier to read.

OK, with that out of the way, let's discuss the code that you posted.

A Worksheet_Change macro such as yours is stored in the Sheet Module for the sheet in which the change you are monitoring will be made. As you probably know, the code monitors changes in the sheet and if the change is to a "target" that matches the criteria you've set forth (Target.Column = 9, etc) the rest of the instructions in the macro will be executed.

One of the subtleties of a WorkSheet_Change macro is that you can only have one per sheet. The doesn't mean you can't monitor more than one thing, but you have to do it all within one Event macro.

For example:

Private Sub Worksheet_Change(ByVal Target As Range)
'stop anything re-triggering this event macro
  Application.EnableEvents = False

On Error GoTo ErrHnd

'test if changed cell is in column I (col. 9) 
  If Target.Column = 9 Then
      'Execute instructions relevant to a change in Column 9
  End If

'test if changed cell is in column J (col. 10) 
  If Target.Column = 10 Then
      'Execute instructions relevant to a change in Column 10
  End If

'test if changed cell is in column K (col. 11) 
  If Target.Column = 11 Then
      'Execute instructions relevant to a change in Column 11
  End If

'error handler
   ErrHnd:
   Err.Clear
  Application.EnableEvents = True
 End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
June 21, 2011 at 12:33:22
Thank you so much for the quick reply, and apologies for the incorrect usage of terms and posting of code; proper format has been noted and will be used henceforth!

This makes sense now as to why I was getting errors. Hopefully between the code in that macro I used and your information I can put this together and get it working! I will post a follow up to let you know how I made out.


Report •

#3
June 21, 2011 at 13:08:59
Still having some issues here... Here is the code that I put together:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'stop anything re-triggering this event macro
Application.EnableEvents = False

On Error GoTo ErrHnd

'test if changed cell is in column I (col. 9) and it contains W (or w)
If Target.Column = 9 And UCase(Target.Text) = "W" Then
    Dim rngCell As Range
    Dim rngDest As Range
    Dim strRowAddr As String
    
    'save target row address
    strRowAddr = Target.Address
    
    'find next row in destination worksheet
    Set rngDest = Worksheets("WHOLESALE"). _
               Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)

    'cut the source row & paste to destination
    Target.EntireRow.Cut Destination:=rngDest
    'remove the cut/copy range marquee
    Application.CutCopyMode = False
     'delete the source row
    Worksheets("RETAIL").Range(strRowAddr).EntireRow.Delete _
        Shift:=xlUp
End If

'test if changed cell is in column N (col. 14) and it contains DELIVERED (or delivered)
If Target.Column = 14 And UCase(Target.Text) = "DELIVERED" Then
    Dim rngCell As Range
    Dim rngDest As Range
    Dim strRowAddr As String
    
    'save target row address
    strRowAddr = Target.Address
    
    'find next row in destination worksheet
    Set rngDest = Worksheets("RETAIL SOLD"). _
               Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)

    'cut the source row & paste to destination
    Target.EntireRow.Cut Destination:=rngDest
    'remove the cut/copy range marquee
    Application.CutCopyMode = False
     'delete the source row
    Worksheets("RETAIL").Range(strRowAddr).EntireRow.Delete _
        Shift:=xlUp
End If

Exit Sub

'error handler
ErrHnd:
Err.Clear
Application.EnableEvents = True
End Sub

The macro is not doing anything anymore (moving rows to other sheets for either target column) and I am getting an error here:

Dim rngCell As Range

The debug says this:
"Compile Error: Duplicate declaration in current scope"

I tried deleting this line, but the next line comes up with an error. I deleted all three lines:

    Dim rngCell As Range
    Dim rngDest As Range
    Dim strRowAddr As String

but still not working. As you can probably tell, I'm not great at coding macros...

Report •

Related Solutions

#4
June 21, 2011 at 15:01:58
I DID IT!!!

Thank you DerbyDad03!

If anyone is interested here is the code I used.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'stop anything re-triggering this event macro
Application.EnableEvents = False

On Error GoTo ErrHnd

'test if changed cell is in column I (col. 9) and it contains W (or w)
If Target.Column = 9 And UCase(Target.Text) = "W" Then
    Dim rngCell As Range
    Dim rngDest As Range
    Dim strRowAddr As String
    
    'save target row address
    strRowAddr = Target.Address
    
    'find next row in destination worksheet
    Set rngDest = Worksheets("WHOLESALE"). _
               Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)

    'cut the source row & paste to destination
    Target.EntireRow.Cut Destination:=rngDest
    'remove the cut/copy range marquee
    Application.CutCopyMode = False
     'delete the source row
    Worksheets("NEW PENDING INVENTORY").Range(strRowAddr).EntireRow.Delete _
        Shift:=xlUp
End If
Application.EnableEvents = True

'test if changed cell is in column I (col. 9) and it contains R (or r)
If Target.Column = 9 And UCase(Target.Text) = "R" Then
    Dim rngCell1 As Range
    Dim rngDest1 As Range
    Dim strRowAddr1 As String
    
    'save target row address
    strRowAddr1 = Target.Address
    
    'find next row in destination worksheet
    Set rngDest1 = Worksheets("RETAIL"). _
               Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)

    'cut the source row & paste to destination
    Target.EntireRow.Cut Destination:=rngDest1
    'remove the cut/copy range marquee
    Application.CutCopyMode = False
     'delete the source row
    Worksheets("NEW PENDING INVENTORY").Range(strRowAddr1).EntireRow.Delete _
        Shift:=xlUp
End If
Application.EnableEvents = True


Exit Sub

'error handler
ErrHnd:
Err.Clear
Application.EnableEvents = True
End Sub




Report •

Ask Question