Macro "add in" to move line back to original worksheet based on changed value

Danielle123

New Member
Joined
May 4, 2018
Messages
7
Hi All,

I have a workbook consisting of 6 worksheets (all with data referring to that location). I have a macro in place to loop through all the worksheets and look for the projects that are "closed" , it then cuts the rows based on the condition and transfers it to a worksheet called closed.

I'm wondering if there's a way of sending that row from the closed worksheet back to the sheet it came from if i changed the condition from = " closed to active "

I've searched site wide and cant find anything relating to it so any help would be greatly appreciated. Below is a sample of my macro i have in place at present.

Thank you


Sub LoopThroughSheets()
Application.ScreenUpdating = False
Dim Ws As Worksheet
For Each Ws In ActiveWorkbook.Worksheets
Dim i As Integer
Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lRow
If Cells(i, 14).Value = "Closed" And Cells(i, 15).Value = "Closed" Then
Range(Cells(i, 1), Cells(i, 24)).Copy Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Range(Cells(i, 1), Cells(i, 24)).ClearContents


End If


Next
Columns("A").SpecialCells(4).EntireRow.Delete
Sheets("Closed").Columns.AutoFit
Sheets("Closed").Select
Application.ScreenUpdating = True


Next Ws
End Sub
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
It shouldn't be too difficult to reverse the code, but you'd need a way to specify which sheet you want to return the re-opened case to. Is there a column in your data that holds info specific to each sheet that you can use as a criteria?
 
Upvote 0
There's not. The projects can refer to any of the 6 locations in the workbook. Is there no way for excel to find the origin worksheet ?
 
Upvote 0
You could add a line to your original code that marks the source worksheet when it's moved to the Closed sheet. Something like this:

Code:
[COLOR=#333333]Sub LoopThroughSheets()[/COLOR]
[COLOR=#333333]Application.ScreenUpdating = False[/COLOR]
[COLOR=#333333]Dim Ws As Worksheet[/COLOR]
[COLOR=#333333]For Each Ws In ActiveWorkbook.Worksheets[/COLOR]
[COLOR=#333333]Dim i As Integer[/COLOR]
[COLOR=#333333]Dim lRow As Long[/COLOR]
[COLOR=#333333]lRow = Range("A" & Rows.Count).End(xlUp).Row[/COLOR]
[COLOR=#333333]For i = 2 To lRow[/COLOR]
[COLOR=#333333]If Cells(i, 14).Value = "Closed" And Cells(i, 15).Value = "Closed" Then[/COLOR]
[COLOR=#333333]Range(Cells(i, 1), Cells(i, 24)).Copy Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
[B]Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(0,25).Value = ws.Name[/B]
[/COLOR][COLOR=#333333]Range(Cells(i, 1), Cells(i, 24)).ClearContents[/COLOR]


[COLOR=#333333]End If[/COLOR]


[COLOR=#333333]Next[/COLOR]
[COLOR=#333333]Columns("A").SpecialCells(4).EntireRow.Delete[/COLOR]
[COLOR=#333333]Sheets("Closed").Columns.AutoFit[/COLOR]
[COLOR=#333333]Sheets("Closed").Select[/COLOR]
[COLOR=#333333]Application.ScreenUpdating = True[/COLOR]


[COLOR=#333333]Next Ws[/COLOR]
[COLOR=#333333]End Sub[/COLOR]

That should place the source worksheet name next to the closed record in column 25. Try that first and see if it works :)
 
Upvote 0
That doesn't seem to work. Its returning the value "Dormant" in column 25 which is strange.

Thank you for all your help on this.
 
Upvote 0
That doesn't seem to work. Its returning the value "Dormant" in column 25 which is strange.

Thank you for all your help on this.


No prob, don't thank me until it works though :)

That's odd - just want to make sure first, is the text Dormant being dropped into the right cell? ie. just to the right of a closed case?

If that bit's okay, move onto finding out where that Dormant value is coming from. Copy this sub into a module and run it, and it'll bring up the name of every worksheet. Just in case there's any hidden:

Code:
Sub nametest()


For Each Worksheet In ActiveWorkbook.Worksheets


MsgBox Worksheet.Name, vbOKOnly


Next Worksheet


End Sub
 
Upvote 0
Haha i'll thank you in advance for the headache this is causing you. Its actually dropping into the column 26 , rang the code for "name worksheet" and there all un-hidden
 
Upvote 0
Haha i'll thank you in advance for the headache this is causing you. Its actually dropping into the column 26 , rang the code for "name worksheet" and there all un-hidden

Lol no prob :)

Sorry yep, that offset should have been 24

Try replacing your code with this instead:


Code:
Sub LoopThroughSheets()


Application.ScreenUpdating = False
On Error Resume Next




Dim ws As Worksheet


For Each ws In ActiveWorkbook.Worksheets
    
    'skip over the Closed sheet as could lead to duplicate/overwrite issues
    If ws.Name = "Closed" Then
        GoTo Skipws
    End If
    
    Dim i As Long
    Dim lRow As Long
    lRow = Range("A" & Rows.Count).End(xlUp).Row
        
        For i = 2 To lRow
        
        If ws.Range("N" & i).Value = "Closed" And ws.Range("O" & i).Value = "Closed" Then
            ws.Range("A" & i & ":X" & i).Copy Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Sheets("Closed").Range("A" & Rows.Count).End(xlUp).Offset(0, 24).Value = ws.Name
            ws.Range("A" & i & ":X" & i).ClearContents
        End If


        Next
    
    Columns("A").SpecialCells(4).EntireRow.Delete
    Sheets("Closed").Columns.AutoFit
    Sheets("Closed").Select
    
    Application.ScreenUpdating = True


Skipws:


Next ws




End Sub

If that works, here's the reversal process as a bonus:

Code:
Sub RestoreActive()


Application.ScreenUpdating = False
On Error Resume Next




Worksheets("Closed").Activate
    
Dim i As Long
Dim lRow As Long
lRow = Range("A" & Rows.Count).End(xlUp).Row
        
For i = 2 To lRow
        
    If Range("N" & i).Value = "Active" Or Range("O" & i).Value = "Active" Then
        Range("A" & i & ":X" & i).Copy Sheets(Range("Y" & i).Value).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        Range("A" & i & ":Y" & i).ClearContents
    End If


Next
    
Sheets("Closed").Columns.AutoFit
Sheets("Closed").Select
    
Application.ScreenUpdating = True




End Sub
 
Upvote 0
Apologies for the late reply. I cant get either of the above codes to work , i think im ready to pull my hair out at this stage :(
 
Upvote 0
Apologies for the late reply. I cant get either of the above codes to work , i think im ready to pull my hair out at this stage :(

Sorry for the delay, I've been away - did you get this working?

If not, the best thing to try might be to run it line by line in break mode and see if you can identify the point(s) at which it's not working as expected: In your VBA window, with the cursor at any position in this Sub, press F8 to start it running, then press Shift + F8 to work through each line. Try and follow what it's doing on the worksheet and see where it goes wrong :)
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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