Selected Answer
Hi again LordBrenden
In the attached revised file, I've set up VBA code to manage (allocate, release) rooms and add new addresses via a "graphical" UserForm.
Firstly, I've converted your data to tables (e.g. add a new row /employee, just type in the column A of the row immediately below on worksheet "Employees").
In worksheet "Rooms", I've added columns I and J for Postal Code and Place respectively (so they can be copied to "Employees") and changed an address (in yellow). Up to 5 properties are allowed and you can change the headings and addresses to suit your native language.
If on worksheet "Employees" you click in column D (for new or existing employee), this event code works:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' do nothing unless a single cell in column D is changed...
If Target.CountLarge > 1 Or Intersect(Target, Columns(4)) Is Nothing Then Exit Sub
' and it's not D1
If Not Intersect(Target, Cells(1, 4)) Is Nothing Then Exit Sub
' launch form
Call ShowForm
End Sub
which calls a module code:
Public AdCell As String
Sub ShowForm()
' capture address (for form)
AdCell = ActiveCell.Address
Userform1.Show
End Sub
where the declaration in bold allows the address of the cell to be passed to the code which sets up the form:
Private Sub UserForm_Initialize()
' add employee name and address to top of form
With Sheet1.Range(AdCell)
Me.Caption = Me.Caption & .Offset(0, -3).Text & " " & .Offset(0, -2).Text & _
" (currently " & .Offset(0, -1).Text & " " & .Text & " " & ", " & .Offset(0, 2).Text & ")"
End With
' populate vacancies
With Sheet2.Range("A2")
' loop down property rows
For n = 0 To 4
' show property address (if any)
If .Offset(n, 0) <> "" Then Me.Controls("LB_Prop" & n + 1).Caption = .Offset(n, 0).Value
' loop along room columns
For p = 1 To 7
If .Offset(n, 0) <> "" Then
' if there's an address...
' grab cell value
Occup = .Offset(n, p).Value
Select Case .Offset(n, p)
Case "N/A"
' if there's no room, don't show
With Me.Controls("OB_Prop" & n + 1 & "Room" & p)
.Caption = ""
.Enabled = False
.Visible = False
End With
Case Is <> ""
' if there's a value, show occupant
With Me.Controls("OB_Prop" & n + 1 & "Room" & p)
.Caption = Occup
.Enabled = False
.Visible = True
End With
End Select
Else
'if no address, hide property and rooms
Me.Controls("LB_Prop" & n + 1).Visible = False 'LB_Prop
Me.Controls("OB_Prop" & n + 1 & "Room" & p).Visible = False
End If
Next p
Next n
End With
End Sub
This populates the form to show whick properties exist and which rooms are occupied or vacant (a blank cell in "Rooms" will show as vacant).
The header of the form reminds you which employee/ location is being changed (with their current address), You can write any new address in the three textboxes near the top. If you don't, you can pick one of the vacant rooms.
If you click cancel, the form goes and nothing happens.
Click Submit and this code checks to see if that employee was in a company rented room and if so sets it to "" (=vacant). It then writes the new address to "Employees". If you didn't add text in those upper boxes, it determines which room was selected, writes the employee name to "Rooms" and adds data to "Employees":
Private Sub CB_Submit_Click()
With Sheet1.Range(AdCell)
'first check if previous address was company rented. Loop down...
For n = 2 To 6
If .Value = Sheet2.Cells(n, 1).Value Then
If .Value <> "" Then
' if matches company address, loop along
For p = 2 To 8
If .Offset(0, -1).Value = Sheet2.Cells(1, p) Then
' if room matches, clear employee room and cell (now vacant)
Sheet2.Cells(n, p).Value = ""
.Offset(0, -1).Value = ""
Exit For
End If
Next p
End If
End If
Next n
' if new address added, write to sheet
If TB_NewAdd <> "" Then
.Value = TB_NewAdd.Text
.Offset(0, 1).Value = TB_Postal.Text
.Offset(0, 2).Value = TB_Place.Text
Else
' if room chosen
For Each OB In Me.Controls
If Left(OB.Name, 3) = "OB_" Then
If OB.Value = True Then
' write name to Rooms
Sheet2.Cells(Mid(OB.Name, 8, 1) + 1, Right(OB.Name, 1) + 1) = .Offset(0, -3).Value & " " & .Offset(0, -2).Value
' write adress etc. to Employees
.Value = Sheet2.Cells(Mid(OB.Name, 8, 1) + 1, 1).Value
.Offset(0, -1).Value = Sheet2.Cells(1, Right(OB.Name, 1) + 1)
.Offset(0, 1).Value = Sheet2.Cells(Mid(OB.Name, 8, 1) + 1, 9).Value
.Offset(0, 2).Value = Sheet2.Cells(Mid(OB.Name, 8, 1) + 1, 10).Value
Exit For
End If
End If
Next OB
End If
End With
'close form
Unload Me
End Sub
I suggest you try it (with the imaginary Nordby address) then correct "Rooms" (clearing names from all rooms) and reallocate them to real employees in "Employees".
Hopefully it all works well for you. If so and your prefer it to other answer(s), please be sure to mark this Answer as Selected.
