Coding Help

[TaylorGall]

Hi All,

I am familiar with using formulas in excel but am struggling with this one as I believe this requires coding.

What I am looking for this to do is the following.

If I type 'OFFSHORE' into column E, the entire row will be moved to the 'OFFSHORE' sheet. Removing the original row from the 'ONSHORE' sheet.
The same for, If I type 'RECERT' or 'REPAIR' into column E, the entire row will be moved to the 'AWAY FOR REPAIR OR RECERT' sheet. Removing the original row from the 'ONSHORE' sheet.

I would also like this to work the other way round.
If when in sheet 'OFFSHORE', I type 'ONSHORE' into column E, the entire row will be moved to the 'ONSHORE' sheet. Removing the original row from the 'OFFSHORE' sheet.
Or I type 'RECERT' or 'REPAIR' into column E, the entire row will be moved to the 'AWAY FOR REPAIR OR RECERT' sheet. Removing the original row from the 'OFFSHORE' sheet.

If when in sheet 'AWAY FOR REPAIR OR RECERT', I type 'ONSHORE' into column E, the entire row will be moved to the 'ONSHORE' sheet. Removing the original row from the 'AWAY FOR REPAIR OR RECERT' sheet.
Or I type 'OFFSHORE' into column E, the entire row will be moved to the 'OFFSHORE' sheet. Removing the original row from the 'AWAY FOR REPAIR OR RECERT' sheet.

Please see attached for reference.

Any help would be greatly appreciated.

Regards
Taylor

 

[mumps]

You will need a macro in the code module for each worksheet . Do the following: right click the tab name for your "ONSHORE" sheet and click 'View Code'. Paste the first macro into the empty code window that opens up. Close the code window to return to your sheet. Repeat these steps for the "OFFSHORE" and "AWAY FOR REPAIR OR RECERT" sheets using the second and third macros respectively.

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 5 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Select Case Target.Value
        Case "OFFSHORE"
            With Target.EntireRow
                .Copy Sheets("OFFSHORE").Cells(Sheets("OFFSHORE").Rows.Count, "A").End(xlUp).Offset(1)
                .Delete
            End With
        Case "RECERT", "REPAIR"
            With Target.EntireRow
                .Copy Sheets("AWAY FOR REPAIR OR RECERT").Cells(Sheets("AWAY FOR REPAIR OR RECERT").Rows.Count, "A").End(xlUp).Offset(1)
                .Delete
            End With
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 5 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Select Case Target.Value
        Case "ONSHORE"
            With Target.EntireRow
                .Copy Sheets("ONSHORE").Cells(Sheets("ONSHORE").Rows.Count, "A").End(xlUp).Offset(1)
                .Delete
            End With
        Case "RECERT", "REPAIR"
            With Target.EntireRow
                .Copy Sheets("AWAY FOR REPAIR OR RECERT").Cells(Sheets("AWAY FOR REPAIR OR RECERT").Rows.Count, "A").End(xlUp).Offset(1)
                .Delete
            End With
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 5 Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Select Case Target.Value
        Case "ONSHORE"
            With Target.EntireRow
                .Copy Sheets("ONSHORE").Cells(Sheets("ONSHORE").Rows.Count, "A").End(xlUp).Offset(1)
                .Delete
            End With
        Case "OFFSHORE"
            With Target.EntireRow
                .Copy Sheets("OFFSHORE").Cells(Sheets("OFFSHORE").Rows.Count, "A").End(xlUp).Offset(1)
                .Delete
            End With
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Enter a value in column E and press the ENTER key.

 

[TaylorGall]

Thank you for your help, but I have just tried this a few times and cannot seem to get it to work.
When Entering value in column E and pressing enter, nothing changes.

 

[TaylorGall]

Hi,

Please see the attached for how I have entered the codes that you sent through.

Thanks.

 

[mumps]

That is correct. If they are not working properly for you, perhaps you could upload a copy of your file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[Joe4]

It may be possible that in your various attempts, if you had any VBA code cancel or quit in the middle, you may have turned off events and not turned them back on.
You can turn events back on by running this code manually:

Sub ReEnableEvents()
    Application.EnableEvents = True
End Sub

You may want to try doing that and running another test, to make sure that isn't the problem.

 

[TaylorGall]

Trial Coding for Inventory List(ONSHORE).csv | Powered by Box

app.box.com

Please see link to the file above.
I am currently not at work and will be inactive for a couple of hours.
There are 3 examples on there to play around with to see if it works.

All help appreciated.
Thanks.

 

[dmt32]

Hi

See if following will do what you want

1 – make a backup of your workbook & then DELETE all existing event codes in each of the worksheets

2 – Insert a STANDARD module (from developer menu Insert > Module)

3 – Place ALL following codes in the module

Option Base 1
Sub MoveRow(ByVal Target As Range, ByVal SheetNames As Variant)
    Dim KeyWord     As Variant, m As Variant
    Dim ws          As Worksheet
    
    If Target.CountLarge > 1 Then Exit Sub
    
    On Error GoTo exitsub
    EventsEnable False
    
    KeyWord = Array("ONSHORE", "OFFSHORE", "RECERT", "REPAIR")
    m = Application.Match(UCase(Target.Value), KeyWord, 0)
    If Not IsError(m) Then
        m = IIf(m = 4, 3, m)
        
        If Target.Parent.Name <> SheetNames(m) Then
            Set ws = Worksheets(SheetNames(m))
            
            With Target.EntireRow
                .Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
                .Delete
            End With
        End If
        
    End If
    
exitsub:
    EventsEnable True
End Sub

Sub EventsEnable(ByVal State As Boolean)
    With Application
        .ScreenUpdating = State
        .EnableEvents = State
    End With
End Sub

Note Option Base 1 statement at the top. This MUST be placed at very TOP of the module OUTSIDE any procedure.

4 – In the developer to the left, double click on ThisWorkbook (see pic) & place all following code

Option Base 1
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim SheetName As Variant, m As Variant
    If Target.Column <> 5 Then Exit Sub
    SheetName = Array("ONSHORE", "OFFSHORE", "AWAY FOR REPAIR OR RECERT")
    m = Application.Match(Sh.Name, SheetName, 0)
    If Not IsError(m) Then MoveRow Target, SheetName
End Sub

Again, note Option Base 1 statement.

Solution only lightly tested but hopefully, if I have understood correctly, this will do what you want

Dave

 

[TaylorGall]

Hi, I have just tried the method above, but still having no luck unfortunately.

Could you please have a look at the attached screenshots to see if I have put the code in correctly?

Thanks.

 

[dmt32]

Hi, I have just tried the method above, but still having no luck unfortunately.

by no luck I assume you mean code is not doing anything?

Try CLOSING the Excel application completely & then re-open & see if any change.
If not, do you have any other codes in your project with the following line? If so, please share all with forum

Application.EnableEvents = False

Dave