VBA to move data

[Gingelp]

Hello,

So I am currently trying to use a Unique ID and make a somewhat move function. The way this works in my head is you type the ID you want to move, you choose from one drop down list of where it is allocated and then you go to another drop list for where it needs to be moved to. (I shall attach the excel sheet so it might be more understandable. No comments about the other code please)

So it needs to do the following
1) Using the ID you want to move, it needs to find it in the Equipment Monitor sheet
2) It then needs to go to the C column in that row and change the department currently allocated to it, to the intended move spot
3) It then needs to go to the specific department sheet where it is also located and change the C column to the intended move spot
4) After it then needs to cut the row out, delete the blank row and move it to its new destination

The more i go over this the more i realise this sucks.

Just noticed I can't Attached the excel sheet so i will add as many photos as i can to show what I mean

image 1 is the main menu sheet where you type the EQ number (F14) Location where it is currently stored is (G14) and where it needs to be moved to is (H14)
image 2 is on the equipment monitor sheet where all products show up
image 3 is just the production sheet where anything on the production tab will show up.

If I can provide any more information that you may need to do this please ask and i shall try supply it asap

 

[JLGWhiz]

I will let you test this. First, check all the sheet names (where i used names) to be sure they are the same as your sheet names. I ssume that the entries in G14 and H14 will be the same as the sheet names for the departments. If not the code will fail.

Sub t()
Dim fn As Range
Set fn = Sheets("Equipment Monitor").Range("A:A").Find(Sheets("Main Menu").Range("F14").Value, , xlValues)
    If Not fn Is Nothing Then
        fn.Offset(, 2) = Sheets("Main Menu").Range("H14").Value
        Set fn = Nothing
    End If
Set fn = Sheets(Sheets("Main Menu").Range("G14").Value).Range("A:A").Find(Sheets("Main Menu").Range("F14").Value, , xlValues)
    If Not fn Is Nothing Then
        fn.Offset(, 2) = Sheets("Main Menu").Range("H14").Value
        fn.EntireRow.Cut Sheets(Sheets("Main Menu").Range("H14").Value).Cells(Rows.Count, 1).End(xlUp)(2)
    End If
End Sub

 

[Gingelp]

Hi JLGWhiz,

I tried to get this to work and the code goes through with no errors but at the same time it doesn't do anything that can be mentioned so I don't know what its doing

Is there a way I can send you the excel workbook? (If so please don't judge about the other code I have a lot of cleaning up to do)

 

[Gingelp]

Oh wow, i have played around with this more and I was wrong it actually works thank you so much!
It also has the flexibility of whatever sheet I desire.

Wow.

I think this is Solved!

 

[JLGWhiz]

Thanks for the feedback,
regards, JLG