VBA to perform multiple checks

E

ExcelSJ

New Member
Joined
May 27, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
Hoping somebody can help with this. My knowledge of VBA is almost non-existent so apologies if I haven't explained things very well!

I've created a booking system and need 2 macros to perform multiple tasks. I've uploaded a couple of images which may help.

BOOK button on Sheet1 when clicked:

1. Check if the desk reference, date and name fields have been entered. If any of these are blank then a message box will appear saying so. If they are all populated then go to step 2...

2. Check if the booking reference generated in cell AA22 is already in column A of Sheet2. If yes then a message box "Desk already booked for date selected. Please choose again." If it isn't already in column A of Sheet 2 then go to step 3...

3. Copies the desk booking reference in cell AA22 and the name in cell AA15 and pastes them to the next available row in columns A and B respectively on Sheet2 then clears the contents in cells AA7, AA11 and AA15 on Sheet1. Message box "Your booking reference is [booking reference]. Please remember this as you will need it if you need to cancel your booking."

Here's what code I already have for the above which is essentially part of step 3. My knowledge doesn't stretch to adding in the other steps.

VBA Code: 
Sub Button1_Click()

ws_output = "BOOKINGS"

next_row = Sheets(ws_output).Range("A" & Rows.Count).End(xlUp).Offset(1).Row

Sheets(ws_output).Cells(next_row, 1).Value = Range("bookref_book").Value
Sheets(ws_output).Cells(next_row, 2).Value = Range("name_book").Value

Range("Z112:AU114").ClearContents
Range("Z116:AU118").ClearContents
Range("Z120:AU122").ClearContents

MsgBox "Your booking reference is XXX-XXXXXX. Please keep a note of this reference as you will need it to cancel your booking", vbOKOnly + vbInformation, ""

End Sub


CANCEL button on Sheet1 when clicked:

Looks for the booking reference in column A on Sheet2 and clears the cell (plus clears the corresponding name in column B if possible). Message box "Your booking has been cancelled." Clears cell BC15 on Sheet1.
 

Attachments

  • Sheet1~2.png
    Sheet1~2.png
    44.8 KB · Views: 21
  • Sheet2~2.png
    Sheet2~2.png
    18.1 KB · Views: 20

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
I'm not using your reference address like "bookref_book". However, feel free to modify code to your need.

I presumed the Sheet1 is name "ENTRY" and Sheet2 name is "BOOKINGS" in the code. So, refine them to your need. Place the code under Sheet ENTRY and I am using ActiveX CommandButton. Button1 for Entry and Button2 for Cancellation.
VBA Code: 
Private Sub CommandButton1_Click()

Dim next_row As Long, nMiss As Long
Dim strNote As String
Dim wsEntry As Worksheet, wsData As Worksheet

Set wsEntry = ActiveWorkbook.Sheets("ENTRY")
Set wsData = ActiveWorkbook.Sheets("BOOKINGS")

next_row = wsData.Range("A" & Rows.Count).End(xlUp).Offset(1).Row

If wsEntry.Range("AA7") = "" Then
    nMiss = 1
    strNote = strNote & "Desk Reference Number" & vbLf
End If
If wsEntry.Range("AA11") = "" Then
    nMiss = nMiss + 1
    strNote = strNote & "Booking Date" & vbLf
End If
If wsEntry.Range("AA15") = "" Then
    nMiss = nMiss + 1
    strNote = strNote & "Name" & vbLf
End If

Select Case nMiss
    Case 1
        MsgBox strNote & "is mising": Exit Sub
    Case Is > 1
        MsgBox strNote & "are mising": Exit Sub
End Select

wsEntry.Range("AA22") = wsEntry.Range("AA7").Value & "-" & _
                                    Format(wsEntry.Range("AA11").Value, "ddmmyy")
wsData.Cells(next_row, 1).Value = wsEntry.Range("AA22").Value
wsData.Cells(next_row, 2).Value = wsEntry.Range("AA15").Value

wsEntry.Range("Z112:AU114").ClearContents
wsEntry.Range("Z116:AU118").ClearContents
wsEntry.Range("Z120:AU122").ClearContents

MsgBox "Your booking reference is" & " " & wsEntry.Range("AA22") & _
            ". Please keep a note of this reference as you will need it to cancel your booking", vbOKOnly + vbInformation

End Sub

Private Sub CommandButton2_Click()

Dim rngData As Range, rngFound As Range
Dim wsEntry As Worksheet, wsData As Worksheet

Set wsEntry = ActiveWorkbook.Sheets("ENTRY")
Set wsData = ActiveWorkbook.Sheets("BOOKINGS")

Set rngData = wsData.Range("D2", wsData.Cells(Rows.Count, "D").End(xlUp))
Set rngFound = rngData.Find(wsData.Range("BC15"), LookIn:=xlValues, LookAt:=xlWhole)

If Not rngFound Is Nothing Then
    MsgBox "Your booking has been cancelled."
    wsData.Range("D" & rngFound.Row, "E" & rngFound.Row).ClearContents
    wsEntry.Range("BC15").ClearContents
Else
    MsgBox "Booking Reference Number has been found."
End If

End Sub
 
Upvote 0
Thank you so much for the reply! I'll try this when next in work.

Much appreciated ?
 
Upvote 0
I've had chance to see if this works and on the whole it does - thank you :) I have just a couple of questions if that's OK. Sorry if I'm not explaining things very well!

1. CommandButton1

A) Needs to check if the booking reference generated within the code (i.e. Format(wsEntry.Range("AA11").Value, "ddmmyy") is already in column A on "BOOKINGS"
- if YES - message box "The desk is already booked for the date given. Please choose a different desk or date" and clears the contents of cells AA7 and AA11
- if NO - records the booking reference and name in the next available row in columns A and B on "BOOKINGS"

B) The button doesn't need to record the booking reference (i.e. Format(wsEntry.Range("AA11").Value, "ddmmyy") in cell AA22 on "ENTRY"

2. CommandButton2

A) Checks if the booking reference entered in cell BC15 is in column A on "BOOKINGS"
- if YES - message box "Your booking has been cancelled" and clears the booking reference in column A on "BOOKINGS" and the corresponding name in column B on the same row, then clears cell BC15 on "ENTRY"
- if NO - message box "That booking reference has not been found. Please try again" and clears cell BC15
 
Upvote 0
Check if this work. The requirement for CommandButton2 is there except I wrote msg as Booking Reference Number has not been found. Without not. ?
Code not tested.
VBA Code: 
Private Sub CommandButton1_Click()

Dim next_row As Long, nMiss As Long
Dim strNote As String, BookCode As String
Dim rngData As Range, rngFound As Range
Dim wsEntry As Worksheet, wsData As Worksheet

Set wsEntry = ActiveWorkbook.Sheets("ENTRY")
Set wsData = ActiveWorkbook.Sheets("BOOKINGS")

Set rngData = wsData.Range("D2", wsData.Cells(Rows.Count, "D").End(xlUp))

next_row = wsData.Range("A" & Rows.Count).End(xlUp).Offset(1).Row

If wsEntry.Range("AA7") = "" Then
    nMiss = 1
    strNote = strNote & "Desk Reference Number" & vbLf
End If
If wsEntry.Range("AA11") = "" Then
    nMiss = nMiss + 1
    strNote = strNote & "Booking Date" & vbLf
End If
If wsEntry.Range("AA15") = "" Then
    nMiss = nMiss + 1
    strNote = strNote & "Name" & vbLf
End If

Select Case nMiss
    Case 1
        MsgBox strNote & "is mising": Exit Sub
    Case Is > 1
        MsgBox strNote & "are mising": Exit Sub
End Select

BookCode = wsEntry.Range("AA7").Value & "-" & Format(wsEntry.Range("AA11").Value, "ddmmyy")
Set rngFound = rngData.Find(BookCode, LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
    wsEntry.Range("AA22") = BookCode
    wsData.Cells(next_row, 1).Value = wsEntry.Range("AA22").Value
    wsData.Cells(next_row, 2).Value = wsEntry.Range("AA15").Value
    MsgBox "Your booking reference is" & " " & wsEntry.Range("AA22") & _
            ". Please keep a note of this reference as you will need it to cancel your booking", vbOKOnly + vbInformation
Else
    MsgBox "The desk is already booked for the date given." & vbLf & "Please choose a different desk or date"
    wsEntry.Range("AA7").ClearContents
End If
wsEntry.Range("Z112:AU114").ClearContents
wsEntry.Range("Z116:AU118").ClearContents
wsEntry.Range("Z120:AU122").ClearContents

End Sub

Private Sub CommandButton2_Click()

Dim rngData As Range, rngFound As Range
Dim wsEntry As Worksheet, wsData As Worksheet

Set wsEntry = ActiveWorkbook.Sheets("ENTRY")
Set wsData = ActiveWorkbook.Sheets("BOOKINGS")

Set rngData = wsData.Range("D2", wsData.Cells(Rows.Count, "D").End(xlUp))
Set rngFound = rngData.Find(wsData.Range("BC15"), LookIn:=xlValues, LookAt:=xlWhole)

If Not rngFound Is Nothing Then
    MsgBox "Your booking has been cancelled."
    wsData.Range("D" & rngFound.Row, "E" & rngFound.Row).ClearContents
    wsEntry.Range("BC15").ClearContents
Else
    MsgBox "Booking Reference Number has not been found."
End If

End Sub
 
Upvote 0
Please ignore the previous code. I have a quick try and there is bug in it.
For the entry Desk Ref, Date Req, and Name, I presumed they are merged cell. So, I rewrote as MergeCell.ClearContents. I also did not write the BOOKINGS sheet column D in my previous code and searching data was also on wrong range. Here is the modified one. Please check if this works as desired
VBA Code: 
Private Sub CommandButton1_Click()

Dim next_row As Long, nMiss As Long
Dim strNote As String, BookCode As String
Dim rngData As Range, rngFound As Range
Dim wsEntry As Worksheet, wsData As Worksheet

Set wsEntry = ActiveWorkbook.Sheets("ENTRY")
Set wsData = ActiveWorkbook.Sheets("BOOKINGS")

Set rngData = wsData.Range("A2", wsData.Cells(Rows.Count, "A").End(xlUp))

next_row = wsData.Range("A" & Rows.Count).End(xlUp).Offset(1).Row

If wsEntry.Range("AA7") = "" Then
    nMiss = 1
    strNote = strNote & "Desk Reference Number" & vbLf
End If
If wsEntry.Range("AA11") = "" Then
    nMiss = nMiss + 1
    strNote = strNote & "Booking Date" & vbLf
End If
If wsEntry.Range("AA15") = "" Then
    nMiss = nMiss + 1
    strNote = strNote & "Name" & vbLf
End If

Select Case nMiss
    Case 1
        MsgBox strNote & "is mising": Exit Sub
    Case Is > 1
        MsgBox strNote & "are mising": Exit Sub
End Select

BookCode = wsEntry.Range("AA7").Value & "-" & Format(wsEntry.Range("AA11").Value, "ddmmyy")
Set rngFound = rngData.Find(BookCode, LookIn:=xlValues, LookAt:=xlWhole)
If rngFound Is Nothing Then
    wsEntry.Range("AA22") = BookCode
    wsData.Cells(next_row, 1).Value = wsEntry.Range("AA22").Value
    wsData.Cells(next_row, 2).Value = wsEntry.Range("AA15").Value
    wsData.Cells(next_row, 4).Value = wsEntry.Range("AA22").Value
    wsData.Cells(next_row, 5).Value = wsEntry.Range("AA15").Value
    MsgBox "Your booking reference is" & " " & wsEntry.Range("AA22") & _
            ". Please keep a note of this reference as you will need it to cancel your booking", vbOKOnly + vbInformation
Else
    MsgBox "The desk is already booked for the date given." & vbLf & "Please choose a different desk or date"
    wsEntry.Range("AA7").MergeArea.ClearContents
End If
wsEntry.Range("Z112:AU114").ClearContents
wsEntry.Range("Z116:AU118").ClearContents
wsEntry.Range("Z120:AU122").ClearContents

End Sub

Private Sub CommandButton2_Click()

Dim rngData As Range, rngFound As Range
Dim wsEntry As Worksheet, wsData As Worksheet

Set wsEntry = ActiveWorkbook.Sheets("ENTRY")
Set wsData = ActiveWorkbook.Sheets("BOOKINGS")

Set rngData = wsData.Range("D2", wsData.Cells(Rows.Count, "D").End(xlUp))
Set rngFound = rngData.Find(wsEntry.Range("BC15"), LookIn:=xlValues, LookAt:=xlWhole)

If Not rngFound Is Nothing Then
    MsgBox "Your booking has been cancelled."
    wsData.Range("D" & rngFound.Row, "E" & rngFound.Row).ClearContents
    wsEntry.Range("BC15").ClearContents
Else
    MsgBox "Booking Reference Number has not been found."
End If

End Sub
 
Upvote 0
Hello. Thank you for the help. I've tested the above code and it almost works :)

The only issue now is I receive a debug error on the following lines of code:

VBA Code: 
wsEntry.Range("Z112:AU114").ClearContents
wsEntry.Range("Z116:AU118").ClearContents
wsEntry.Range("Z120:AU122").ClearContents

...and...

VBA Code: 
wsEntry.Range("BC15").ClearContents

Is it because the above ranges are merged cells? The sheet will also be protected with just those ranges above editable (plus the command buttons of course).

Also, there has been a slight change since I last wrote in that this workbook will link to a separate workbook. I therefore need links to automatically update when this workbook is opened and refresh links every second. Is that possible?

Thank you :)
 
Upvote 0
ExcelSJ said:
Hello. Thank you for the help. I've tested the above code and it almost works :)

The only issue now is I receive a debug error on the following lines of code:

VBA Code: 
wsEntry.Range("Z112:AU114").ClearContents
wsEntry.Range("Z116:AU118").ClearContents
wsEntry.Range("Z120:AU122").ClearContents

...and...

VBA Code: 
wsEntry.Range("BC15").ClearContents

Is it because the above ranges are merged cells? The sheet will also be protected with just those ranges above editable (plus the command buttons of course).

Also, there has been a slight change since I last wrote in that this workbook will link to a separate workbook. I therefore need links to automatically update when this workbook is opened and refresh links every second. Is that possible?

Thank you :)
Click to expand...
For merged cell, I have one corrected to clear the merged cell, but I think I missed the range BC15
wsEntry.Range("AA7").MergeArea.ClearContents

so for the BC it should be
wsEntry.Range("BC15").MergeArea.ClearContents

On these, I have no idea
VBA Code: 
wsEntry.Range("Z112:AU114").ClearContents
wsEntry.Range("Z116:AU118").ClearContents
wsEntry.Range("Z120:AU122").ClearContents

It depends on your sheet which I have no idea whether those ranges are protected or merged cells, but for merged cell you only need the top left most address like Range AA7 and Range BC15 above.

I also do not understand on the link part you mentioned. You can automatically run macro when opening the workbook by putting the macro in ThisWorkbook sheet under event below
VBA Code: 
Private Sub Workbook_Open()

End Sub

but how you want to update link? If the source workbook data is at the same location, wouldn't the data is updated automatically? Do you meant without prompt?
 
Upvote 0
Solution
The booking and cancelling functions are now working perfectly :)

I've changed things so there's no linked workbook so no need to worry about that.
 
Last edited by a moderator:
Upvote 0
Thank you Zot for all of your help with this. It's really appreciated :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
VBA to open file using Cell for the path
Replies
4
Views
533
Peter Davison
P
L
  • Solved
Clear multiple range contents, multiple protected sheets, vba
Replies
2
Views
202
Lelewiwi
L
G
  • Question
VBA help - copy cells from specific table to specific table on another sheet.
Replies
0
Views
227
GardianAngelUK
G
P
  • Question
How to find a word then cross reference to see if match
Replies
0
Views
283
Patriot2879
P
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
335
Agnarr
Agnarr

Forum statistics

Threads
1,214,427
Messages
6,119,419
Members
448,895
Latest member
omarahmed1

Share this page

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
Back
Top