order inventory macro

[blairw]

Hi there
i have a workbook to track my order process status
it has 6 pages:
Stock - New Orders
CNC
Make
Paint
Dispatch
Complete
Every order passes from each sheet in order till complete where it stays

each row in the sheet has the details of the order
what i need is to be able to move an order(row) from 1 sheet to the next
by typing the next stage(which is the next sheets name in column b of the order row

so an order starts in stock - new orders
when "cnc" or "make" is inserted into column b of the orders row the order moves to the cnc or make sheet
then when the same colum b cell is changed to "paint" it moves to the paint sheet and so on

i tried recording a macro using advanced filter but doesnt move the order only copies it and before long leaves the stock - new orders littered with orders which i cant remove as they dissapear from the other sheets too if i delete them

Many thanks in advance
blair

[JBeaucaire]

This macro would go in the ThisWorkbook module and will watch for changes in column B of all sheets. If you change something, it will move it.

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell As Range, wsNm As String

For Each cell In Target
    If cell.Column = 2 And cell.Value <> Sh.Name And cell.Value <> "" Then
        wsNm = cell.Value
        If Evaluate("ISREF('" & wsNm & "'!A1)") Then
            Application.EnableEvents = False
            cell.EntireRow.Cut Sheets(wsNm).Range("A" & Rows.Count).End(xlUp).Offset(1)
            Rows(cell.Row).Delete xlShiftUp
            Sheets(wsNm).Activate               'this is optional to follow the row...delete if not undesired
            Sheets(wsNm).Columns.AutoFit
            Application.EnableEvents = True
        Else
            MsgBox "No sheet with that name exists, row not moved."
        End If
    End If
Next cell

End Sub

[blairw]

HI AGAIN

AH So Close
it is working a treat apart from
the rows once edited with the new status such as make or paint etc over rights the first row in the named sheet ?
the named sheets only store 1 row and continously gets over written by the next ?

many thanks
blair

[JBeaucaire]

Which column in your workbook ALWAYS has data in it on used rows? All my workbooks use column A, but apparently yours are empty.

[Winon]

Hi blairw,

Why don't you upload a sample WorkBook with all your data, for us to have a look at?

[JBeaucaire]

Since we know column B is being used, perhaps this will work better for you:

            cell.EntireRow.Cut Sheets(wsNm).Range("B" & Rows.Count).End(xlUp).Offset(1, -1)

[blairw]

Hi Folks
i found what the problem was. as i require the cell text auto complete for the various options and items in the same column listed above i had a space inserted in the cells.
however :
the script below works very well but when i change the cell in column A and the row goes to the sheet with that name it leaves an empty row
which interfears with the cell text auto complete. is it possible for the code to remove the row it leaves behind when it moves ?
much appreciated
blair

order inventory.xlsm

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell As Range, wsNm As String

For Each cell In Target
    If cell.Column = 1 And cell.Value <> Sh.Name And cell.Value <> "" Then
        wsNm = cell.Value
        If Evaluate("ISREF('" & wsNm & "'!A1)") Then
            Application.EnableEvents = False
            cell.EntireRow.Cut Sheets(wsNm).Range("A" & Rows.Count).End(xlUp).Offset(1)
            Rows(cell.Row).Delete xlShiftUp
            Sheets(wsNm).Activate               'this is optional to follow the row...delete if not undesired
            Sheets(wsNm).Columns.AutoFit
            Application.EnableEvents = True
        Else
            MsgBox "No sheet with that name exists, row not moved."
        End If
    End If
Next cell

End Sub

[JBeaucaire]

Change this:

            cell.EntireRow.Copy Sheets(wsNm).Range("A" & Rows.Count).End(xlUp).Offset(1)

[blairw]

DONE !!!
Thanks JB
you have put an end to my stressing !!
i cant thank you enough you have been a great help
Blair