Room reservation in sort of calendar

[Marc76]

Hello,
please apollogize my bad english, it's not my first language. Hope I won't be misunderstood.

Here's my problem.
I made a workbook for reservations of different rooms.
InThis workbook has for each month a worksheet.
In the column A are the differents rooms and below every room the time settings as 0800-0900 and 0900-1000.
The problem is, that we have a room with a capacity of 83 places.
This room can be splittet in a room of 51 places and one of 32 places.

There are a few users who are able to enter reservations of the rooms an they paste datas by ctrl C and ctrl V. To solve the problem by pasting conditional formattings I found a VBA code.

Now I'm looking for a code that protects cells. (data validation is no option)

So in column A are the names of rooms and the time settings. B-AF are the days 1., 2., 3. etc.

The code should do this:
By leaving the cell B10 (0800-1000 of the room with 83 places) after entering a text, the cell B17 (0800-1000 of the room with 51 places) an d the cell B23 (0800-1000 of the room with 32 places) should be protected that no entry or even selection of this cell is possible and unprotected if the value is deleted.

Even the opposite way. By leaving the cell B17, the cell B10 should be protected, the cell B23 is still open.

You can imagine the macros I'would have to write, but I need one that I will modify.

B10 -> B17 & B23
B11 -> B18 & B24
B12 -> B19 & B25
etc

Then B17 -> B10
B18 -> B11
etc

B23 -> B10
B24 -> B11

an this for each column: B-AF

A problem that I wasn't able to solve, is that I got a "debug" message when ther is more than one time the code "Private Sub Worksheet_Change(ByVal Target As Range)"

Maybe it would be possible to find a solution that the specific macro only runs when one of these cells changed theyr value.

Thank you very much for all solutions.

Best regards Marc

(Greetings from Luxembourg)

[Paul_Hossler]

You can only have one

"Private Sub Worksheet_Change(ByVal Target As Range)" in a module

If the same sheet has to do different things, that I use the Target (i.e. what cell(s) changed

….

If Not Intersect (Target, Range ("A1:B2") is Nothing Then

….. do something


ElseIf Not Intersect (Target, Range ("C1:D2") is Nothing Then

….. do something else


etc.


End IF

[Marc76]

Hi Paul,

thank you for your answer.

I don't understand why tha target ist about two columns. A and B / C and D

In Column A are the names of the rooms and below a shedule like:

Complete Room
0800-0900
0900-1000
1000-1100
1100-1200
1300-1400

First part of room
0800-0900
0900-1000
.....

Second part of room
0800-0900
0900-1000
...

In column B is the name of the person who asked to have the room in the corresponding row. (time shedule)

So if someone asked the complete room in the shedule from 0800-0900 I enter his name in column B in that row.
After entering the name the cell in column B of the row (0800-0900) of the first part an second part should be locked.

If someone asked the first part of the room, then de complete room should be locked, but not the second part.


Maybe I don't explain good enough in my basic english.

Thanks to all.

Marc

[Paul_Hossler]

You said ...

A problem that I wasn't able to solve, is that I got a "debug" message when there is more than one time the code "Private Sub Worksheet_Change(ByVal Target As Range)

so I assumed (possibly incorrectly) that you have TWO subs called "Worksheet_Change" in one worksheet module, one for one range (say A:A) and one for another (say B:B)

I don't understand why tha target ist about two columns. A and B / C and D

That was an example. I said that you can't have two subs like that and you could consolidate them into a single and depending on the cell that changed (col A or Col B) and decide which logic to use


This is just a starting point -- I used "X" to block it out

Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, r1 As Range
    Dim N As Long
    
    Set r = Target.Cells(1, 1)
    
    If Intersect(r, Columns(2)) Is Nothing Then Exit Sub
    
    If Len(r.Offset(0, -1).Value) = 0 Then Exit Sub
    
    Set r1 = r.Offset(0, -1).CurrentRegion
    
    If r1.Cells.Count < 2 Then Exit Sub
    
    N = r1.Rows.Count / 3   '   number of rows per block
    Application.EnableEvents = False
    
    Select Case (r.Row - r1.Row + 1)
        Case 2 To N                                   '   complete room
            Cells(r.Row + N, 2).Value = "X"
            Cells(r.Row + 2 * N, 2).Value = "X"
        Case N + 1 To 2 * N                             '  first part room
            Cells(r.Row - N, 2).Value = "X"
        Case 2 * N + 1 To 3 * N                           '   second part room
            Cells(r.Row - 2 * N, 2).Value = "X"
    End Select
    Application.EnableEvents = True

End Sub