VBA - Move Certain cells (column) based off of contents of row.

Oranjin

Board Regular
Joined
Mar 16, 2016
Messages
81
I have seating arrangement in excel that I'm trying to spiff up. I have begun to embark on the great mystery of actually making macro's work. So far, I'm a little over my head. I would appreciate any help with this, I cannot imagine it's very complicated for someone who knows what they are doing.

I want to be able to say, "I want to move Steve Steve to Cubicle 4030" From wherever he is now. These are some additonal parameters

  1. If someone is seated in 4017 then I don't want bob to be moved there. I want a warning that says, "Someone is currently seated there"
  2. The following columns have formulas that I don't want to be taken with bob when he moves, because they'll auto-populate in bob's new row.
    1. D,E,F and L

Below is an example of the data to be arranged:

ABCDEFGHIJKLM
550DepartmentsTeams660 Floor660 QuadSamaccountnameSeat TypeFirst NameLast NameDisplay NameStation LocationWorkstation Power Port
551FinanceA2SESteve.SteveSupportSteveSteveSteve Steve2212East 76
552ImplementationB3SWDave.DaveSupportDaveDaveDave Dave3130West 76
553Open4NWOpen SlotOpen Slot4030West 85

<tbody>
</tbody>

To reiterate:

I want to be able to enter "Move Steve to cubicle 4030" and then have columns B,C,G.H,I from row 550 to 553 w/out overwriting the forumals that are in D, E, F and L. Additionally, if I were to enter, "Move Steve to cubicle 3130" I would want to have the cell turn red where you enter the necessary information, and or get some sort of warning that said, "There is someone currently in that cubicle"

Any help is appreciated.

Thanks
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,069
Office Version
  1. 2013
Platform
  1. Windows
Oranjin,

I'm assuming that columns BC GHI have data moved and DEF JKL contain formula ??

Name to move in F2 and seat to move to in H2 '*** edit the code to change to actual input cells
My data starts with headers in row 5.
If yours is e.g. 550 as appears above then edit to suit in the code line that sets fr

Excel Workbook
BCDEFGHIJKL
1****Display Name*Seat****
2***MoveSteve SteveTo4030****
3***********
4***********
5DepartmentsTeams660 Floor660 QuadSamaccountnameSeat TypeFirst NameLast NameDisplay NameStation LocationWorkstation Power Port
6**2SE*****2212East 76
7ImplementationB3SWDave.DaveSupportDaveDaveDave Dave3130West 76
8FinanceA4NWSteve.SteveSupportSteveSteveSteve Steve4030West 85
Sheet2


This code hopefully does what you want or will give you a good start.

Code:
Sub Move_Seat()


Person = Range("F2")
Seat = Range("H2")


fr = 5  '******edit for your first row  i.e.  data headers row  550 ?


lr = Cells(Rows.Count, "K").End(xlUp).Row 'last row by testing column K




'Find person row using column J
On Error Resume Next
pr = WorksheetFunction.Match(Person, Range("J" & fr & ":J" & lr), 0) + fr - 1


'Bail out if not found
If Not pr > 0 Then
    MsgBox "Cannot match that name.  Please try again"
    On Error GoTo 0
    Exit Sub
End If


'Find new seat row using column K
sr = WorksheetFunction.Match(Seat, Range("K" & fr & ":K" & lr), 0) + fr - 1


'Bail out if not found


If Not sr > 0 Then
    MsgBox "Cannot match that saet.  Please try again"
    On Error GoTo 0
    Exit Sub
End If
    
'Otherwise, test if new seat is occupied by cheking H & I for names ??
If Range("H" & sr) = "" And Range("I" & sr) = "" Then   'seat is not occupied so..
   'surpress screen updates and calculation
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
    'move details
     Range("B" & sr & ":C" & sr).Value = Range("B" & pr & ":C" & pr).Value
     Range("G" & sr & ":I" & sr).Value = Range("G" & pr & ":I" & pr).Value
     
     'Clear old details
     Range("B" & pr & ":C" & pr).ClearContents
     Range("G" & pr & ":I" & pr).ClearContents
    'reset update and calc
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    Else    'otherwise..
    
    MsgBox "That seat is occupied.  Please try again."
    On Error GoTo 0
End If


End Sub

Hope that helps.
 

Oranjin

Board Regular
Joined
Mar 16, 2016
Messages
81
I changed a couple of things to get it working. It's running at a clip. I added one more subscript. You'll see. What I don't understand is, the subscript is dropping those values into the range I have selected. I would like the values Open, Open Slot and Open Slot to fall into the following cells.

b= "Open"
C= " "
D= Formula - Leave as is
E = Formula - Leave as is
F = Formula - Leave as is
G = "Open Slot"
H= " "
I = " "
J= Formula - Leave as is

I think that code I added is pretty close. Please let me know what additions I need to make.

Steve
Code:
Sub Move_Seat()




Person = Range("F2")
Seat = Range("H2")




fr = 12  '******edit for your first row  i.e.  data headers row  550 ?




lr = Cells(Rows.Count, "K").End(xlUp).Row 'last row by testing column K








'Find person row using column J
On Error Resume Next
pr = WorksheetFunction.Match(Person, Range("J" & fr & ":J" & lr), 0) + fr - 1




'Bail out if not found
If Not pr > 0 Then
    MsgBox "Cannot match that name.  Please try again"
    On Error GoTo 0
    Exit Sub
End If




'Find new seat row using column K
sr = WorksheetFunction.Match(Seat, Range("K" & fr & ":K" & lr), 0) + fr - 1




'Bail out if not found




If Not sr > 0 Then
    MsgBox "Cannot match that saet.  Please try again"
    On Error GoTo 0
    Exit Sub
End If
    
'Otherwise, test if new seat is occupied by cheking H & I for names ??
If Range("H" & sr) = "" And Range("I" & sr) = "" Then   'seat is not occupied so..
   'surpress screen updates and calculation
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
    'move details
     Range("B" & sr & ":C" & sr).Value = Range("B" & pr & ":C" & pr).Value
     Range("G" & sr & ":I" & sr).Value = Range("G" & pr & ":I" & pr).Value
     
     'Clear old details
     Range("B" & pr & ":C" & pr).ClearContents
     Range("G" & pr & ":I" & pr).ClearContents
     
     
    'reset update and calc
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    'reset cells
    
rw = ActiveCell.Row


    Range("B" & rw) = "Open"
    Range("C" & rw) = ""
    Range("G" & rw) = "Open Slot"
    Range("H" & rw) = ""
    Range("I" & rw) = ""
    Range("J" & rw) = "Open Slot"
    Range("C5").Select
    ActiveCell.FormulaR1C1 = ""
    
    Else    'otherwise..
    
    MsgBox "That seat is occupied.  Please try again."
    On Error GoTo 0
End If




End Sub
 

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,069
Office Version
  1. 2013
Platform
  1. Windows
Steve,


I have tweaked your code slightly to hopefully give what you want although your code and your last post appear to give conflicting requirements for J ???

Your use of rw is dodgy as you are setting rw to the row of the Active Cell which could be any old cell you have selected at the time ??
Hence I have used pr which is the row of the person you are moving and is independent of the Active cell.

Code:
Sub Move_Seat()


Person = Range("F2")
Seat = Range("H2")


fr = 12  '******edit for your first row  i.e.  data headers row


lr = Cells(Rows.Count, "K").End(xlUp).Row 'last row by testing column K




'Find person row using column J
On Error Resume Next
pr = WorksheetFunction.Match(Person, Range("J" & fr & ":J" & lr), 0) + fr - 1




'Bail out if not found
If Not pr > 0 Then
    MsgBox "Cannot match that name.  Please try again"
    On Error GoTo 0
    Exit Sub
End If




'Find new seat row using column K
sr = WorksheetFunction.Match(Seat, Range("K" & fr & ":K" & lr), 0) + fr - 1




'Bail out if not found


If Not sr > 0 Then
    MsgBox "Cannot match that saet.  Please try again"
    On Error GoTo 0
    Exit Sub
End If
    
'Otherwise, test if new seat is occupied by cheking H & I for names ??
If Range("H" & sr) = "" And Range("I" & sr) = "" Then   'seat is not occupied so..
   'surpress screen updates and calculation
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
    'move details
     Range("B" & sr & ":C" & sr).Value = Range("B" & pr & ":C" & pr).Value
     Range("G" & sr & ":I" & sr).Value = Range("G" & pr & ":I" & pr).Value
     
     'Reset old details
     Range("B" & pr) = "Open"
     Range("C" & pr).ClearContents
     Range("G" & pr) = "Open Slot"
     Range("H" & pr & ":I" & pr).ClearContents
     Range("J" & pr) = "Open Slot"   '???????????  or formula so leave it ?????
     
    '***
    Range("C5").Select
    ActiveCell = ""
    
    'reset update and calc
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
   
    Else    'otherwise..
    
    MsgBox "That seat is occupied.  Please try again."
    On Error GoTo 0
End If


End Sub
 

Oranjin

Board Regular
Joined
Mar 16, 2016
Messages
81
Thank you! I've added a couple of things but this was perfect! You saved the day!

Steve
 

Watch MrExcel Video

Forum statistics

Threads
1,122,914
Messages
5,598,840
Members
414,261
Latest member
KatieBsc

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
Top