Duplicate Subroutine names for moving rows to different sheets and workbook

PerryK

New Member
Joined
May 8, 2018
Messages
27
Hello everyone, I am brand new to coding, and I am trying to use the code to move rows to different sheets and to move completed rows to a different work and I am having trouble that the Sub Worksheet_Change is being seen as ambiguous name and doesn't work when I try to change the name to something like Worksheet_ChangeCOMPLETE or WorkSheet_Change3, also rngDest has the same issue in all 3 codes, below is the codes that I am trying to use. What my plan is that I want completed orders (rows) to move to a new workbook in which I have named "COMPLETED" when a command button is pushed which triggers a Macro to insert the word "COMPLETE" in column 13 (M). This new workbook was formerly my sheet 2 but I made it a new workbook and saved it as COMPLETED.xlxs I also need rows to move to sheet 3 when "PARTIAL HOLD" inserted in column 13 via a different command button and then returned to sheet one when the command button on sheet 3 "RESUME" is clicked. All workbooks and worksheets have all the same columns and spacing, I just can't get the codes to work when I rename them. The first set of codes I am posting are for moving rows from sheet 1 to sheet 3 when the command button is pressed, followed by the code to move rows to the new workbook these codes are in Sheet 1 under VBA project, not a module. The third is on sheet 3 to move rows back to sheet 1 once HOLD is complete. Thank you in advance for your help.


SHEET 1
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDest As Range
Set rngDest = Sheet3.Range("A5:R5")
If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
If UCase(Target) = "PARTIAL HOLD" Then
Application.EnableEvents = False
Target.EntireRow.Select
Selection.Cut
rngDest.Insert shift:=xlDown
Selection.Delete
Application.EnableEvents = True
End If
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim destWbk As String
Dim wbk As Workbook
Dim rngDest As Range
destWbk = ThisWorkbook.names("COMPLETED.xlsx").RefersTo
destWbk = Replace(destWbk, "=" & Chr(34), "")
destWbk = Replace(destWbk, Chr(34), "")
Set wbk = Application.Workbooks(destWbk)
Set rngDest = wbk.names("A1:S1").RefersToRange
If Not Intersect(Target, Sheet1.Range("COMPLETE")) Is Nothing Then
If UCase(Target) = "COMPLETED" Then
Application.EnableEvents = False
Target.EntireRow.Select
Selection.Cut
rngDest.Insert shift:=xlDown
Selection.Delete

Application.EnableEvents = True
End If
End If
End Sub

SHEET 3

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDest As Range
Set rngDest = Sheet1.Range("A5:S5")
If Not Intersect(Target, Sheet3.Range("M5:M290")) Is Nothing Then
If UCase(Target) = "IN PROGRESS" Then
Application.EnableEvents = False
Target.EntireRow.Select
Selection.Cut
rngDest.Insert shift:=xlDown
Selection.Delete
Application.EnableEvents = True
End If
End If
End Sub
 
Last edited by a moderator:

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
The worksheet_change macro is a built in feature of Excel VBA. It is triggered to run automatically when changes are made to a worksheet where the macro has been installed into the sheet code module. Because it is triggered by the change event of the worksheet, there can be only one worksheet-change macro per sheet. You have some options. You can either write a single worksheet_change macro that uses If...then statements to execute different actions for different criteria, or you can write separate macros which would reside in the public code module 1 and be called by the worksheet_change macro when the criteria is met.
 
Upvote 0
I was given this to try by someone else. The first part of it works when I have bad rngDest in the other portions but when I have the code as it is below I get a compile error: Duplicate declaration in current scope. Thank you again for your help.

Sheet 1 not in module
code:
<code style="margin: 0px; padding: 0px; border: 0px; font-style: inherit; font-variant: inherit; font-weight: inherit; font-stretch: inherit; line-height: inherit; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; vertical-align: baseline; box-sizing: inherit; white-space: inherit;">Private Sub Worksheet_Change(ByVal Target As Range)
If UCase(Target.Value) = "PARTIAL HOLD" Then
Dim rngDest As Range
Set rngDest = Sheet3.Range("A5:R5")

If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
Application
.EnableEvents = False
Target
.EntireRow.Select
Selection
.Cut
rngDest
.Insert Shift:=xlDown
Selection
.Delete
Application
.EnableEvents = True
End If
ElseIf UCase(Target.Value) = "IN PROGRESS" Then
Dim rngDest As Range
Set rngDest = Sheet1.Range("A5:S5")

If Not Intersect(Target, Sheet3.Range("M5:M290")) Is Nothing Then
Application
.EnableEvents = False
Target
.EntireRow.Select
Selection
.Cut
rngDest
.Insert Shift:=xlDown
Selection
.Delete
Application
.EnableEvents = True
End If
ElseIf UCase(Target.Value) = "COMPLETED" Then
Dim destWbk As String
Dim wbk As Workbook
Dim rngDest As Range


destWbk
= ThisWorkbook.Names("COMPLETED.xlsx").RefersTo
destWbk
= Replace(destWbk, "=" & Chr(34), "")
destWbk
= Replace(destWbk, Chr(34), "")

Set wbk = Application.Workbooks(destWbk)

Set rngDest = wbk.Names("A1:S1").RefersToRange

If Not Intersect(Target, Sheet1.Range("COMPLETE")) Is Nothing Then
Application
.EnableEvents = False
Target
.EntireRow.Select
Selection
.Cut
rngDest
.Insert Shift:=xlDown
Selection
.Delete
Application
.EnableEvents = True
End If
End If
End Sub
</code>
 
Upvote 0
It is referring to your Dim statements. You only need to declare a variable once for the entire macro. If you declare it with a Dim more than once it will give you that error. Just delete the duplicate declarations, or comment them out. I would delete them. They should all be at the top of the macro anyhow, then you could see if you have duplicates quite easily. The Dim statement allows VBA to reserve memory for the variable type.
 
Last edited:
Upvote 0
Thank you for the advice, I am trying that now, and I think I have solved one problem to run into another. I have the whole code in sheet 1 and the function of the first part of the code works when testing just that function. When testing the second part nothing happens. The "IN PROGRESS" on sheet 3 shows as its supposed to but the row does move back to sheet 1.
I have a process the puts "IN PROGRESS" on sheet 1 and when I click on that button I am getting "run time error '1004': Method 'Intersect' of Object'_Global' failed" when I click on debug it highlights the line 16 If Not Intersect (Target, Sheet3.Range("M5:M290")) is Nothing Then
When testing the third i get a "run time error '1004': application-defined or object-defined error" this highlights line 24 destWbk=ThisWorkbook.Names("COMPLETED.xlxs").RefersTo when I click debug

Code:
Private Sub Worksheet_Change(ByVal Target As Range)Dim rngDest As Range, rngDest2 As Range, rngDest3 As Range
Dim destWbk As String
Dim wbk As Workbook
     If UCase(Target.Value) = "PARTIAL HOLD" Then
        Set rngDest = Sheet3.Range("A5:R5")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "IN PROGRESS" Then
        Set rngDest3 = Sheet1.Range("A5:S5")
        If Not Intersect(Target, Sheet3.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest3.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "COMPLETE" Then
        destWbk = ThisWorkbook.Names("COMPLETED").RefersTo
        destWbk = Replace(destWbk, "=" & Chr(34), "")
        destWbk = Replace(destWbk, Chr(34), "")
        Set wbk = Application.Workbooks(destWbk)
        Set rngDest2 = wbk.Range("A1:S1")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
             Application.EnableEvents = False
             Target.EntireRow.Cut
             rngDest2.Insert Shift:=xlDown
             Target.EntireRow.Delete
             Application.EnableEvents = True
        End If
    End If
End Sub

Thank you again I really appreciate the help.
 
Upvote 0
If Sheet3 is not the same sheet the code is in, it will throw and error with Intersect(Target, Sheet3....) because you are attempting to intersect a ranges on separate sheets. The ranges which intersect must be on the same sheet. If you are trying to designate a cell on sheet3 using the Target row or column then you could use
Code:
If Not Intersect(Sheet3.Cells(Target.Row, Target.Column), Sheet3.Range("M5:M290")) Is Nothing Then
Otherwise I would assume that Sheet3 is a typo and you really want the current sheet which needs no reference to the parent because VBA knows where it is.
Code:
If Not Intersect(Target, Range("M5:M290")) Is Nothing Then

Rememberf when referencing ranges, that if the parent sheet is other than the active sheet, it must be referenced in the code. You cannot mix ranges from one parent sheet to another, so check all of your parent references when using a range reference. Target in worksheet event code refers to the sheet hosting the code.
 
Last edited:
Upvote 0
What I am trying to do is move an entire row from sheet 3 to sheet 1. The process right before this one moves an entire row from sheet 1 to sheet 3. I need to move it back once the correct value is entered into column M. That value will be "PROGRESSING" as I was trying to use IN PROGRESS but another process that uses IN PROGRESS was interfering so I had to change it. I am also getting a run time error on line 24 when trying to move completed rows to a new workbook.
 
Upvote 0
Please help. What do I need to do to move a row from sheet 1 to sheet 3 when PARTIAL HOLD is input into column M (13) and from sheet 3 back to sheet 1 when PROGRESSING is input into column M (13). Also what can I do to move a row from sheet 1 to a new workbook when COMPLETED is input into column M (13)? Previous attempts with this code have gotten me run time errors on lines 16 and 24. Now that I have added the clickable cells instead of command buttons and none of it is running at all except the clickable cells. What am I missing? What needs to change?
Sheet 1
Code:
Dim wbk As Workbook
     If UCase(Target.Value) = "PARTIAL HOLD" Then
        Set rngDest = Sheet3.Range("A5:Q5")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "PROGRESSING" Then
        Set rngDest3 = Sheet1.Range("A5:Q5")
        If Not Intersect(Sheet3.Cells(Target.Row, Target.Column), Sheet3.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest3.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "COMPLETE" Then
        destWbk = ThisWorkbook.Names("COMPLETED.xlsm").RefersTo
        destWbk = Replace(destWbk, "=" & Chr(34), "")
        destWbk = Replace(destWbk, Chr(34), "")
        Set wbk = Application.Workbooks(destWbk)
        Set rngDest2 = wbk.Range("A1:Q1")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
             Application.EnableEvents = False
             Target.EntireRow.Cut
             rngDest2.Insert Shift:=xlDown
             Target.EntireRow.Delete
             Application.EnableEvents = True
        End If
    End If
End Sub


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
On Error GoTo Xit
   If Target.Column = 11 Then
      Cancel = True
      Target.Offset(, 2).Value = "IN PROGRESS"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 12 Then
      Cancel = True
      Target.Offset(, 1).Value = "COMPLETE"
      Target.Offset(, 4).Value = Time
   ElseIf Target.Column = 14 Then
      Cancel = True
      Target.Offset(, -1).Value = "PARTIAL HOLD"
      Target.Offset(, 3).Value = Time
   End If
Xit:
Application.EnableEvents = True
End Sub
Here is the code I have on Sheet 3
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Target.Column < N > 14 Then Exit Sub
   Cancel = True
   Target.Offset(, -1).Value = "PROGRESSING"
End Sub
 
Upvote 0
Code:
[COLOR=#FF0000]If Not Intersect(Sheet3.Cells(Target.Row, Target.Column), Sheet3.Range("M5:M290")) Is Nothing Then[/COLOR]
I gave you this as an example of how it could be referenced when sheet1 is the host for the code, but if the cell Identified byt 'Target,Row, Taget.Column' on sheet3 is not the same as that on sheet1, then it could just be ignoring the statement. Since I have no visibility of your work, it is difficult for me to offer anything more.
Regards, JLG
 
Upvote 0
JLGWhiz first off thank you very much for your patience and all the time and help you have provided me so far. The code is on sheet 1 and the row that I am trying to move is on sheet 3 and even after implementing your amendment to line 16 it is still not working. Is there code I need to put on sheet 3 to enable this move to happen or am I trying to do something that is impossible? Thank you again.
 
Upvote 0

Forum statistics

Threads
1,213,532
Messages
6,114,177
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top