Updating Edited Information in form with VBA

I

ismael9

New Member
Joined
Dec 27, 2021
Messages
7
Office Version
  1. 2021
Platform
  1. Windows
hi,

I have close to zero experience with VBA, however I understand excel relatively well.

I have followed a room booking system tutorial from pconline learning (which I have attached below). However, the "edit booking" macro/button was not covered and I was wondering if anyone had any idea what coding would be required?

In the "edit booking" button I currently have coding which I found online from another user from this website, however the code doesn't edit the data, it instead appears to simply clear the date inputted in the above textboxes whilst retaining the date in the separate sheet.

I would like the "edit booking" button to allow me to click on a cell with a booked user, look up his information (using the currently working "look up" button), and then change his data in the spreadsheet, for example move the user from room 5 to 10, or change his status from unconfirmed to confirmed.

I've attached images below and would be grateful for any help

1640631347652.png

1640631366282.png

1640631410894.png

1640631427069.png
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Sort by date Sort by votes
Hi welcome to forum

To assist, it is helpful if you can post the actual code for your project using the VBA code tags from the menu bar or for such an involved project, place copy of your workbook with dummy data on a file sharing site like dropbox & provide a link to it.

Plenty here to offer guidance

Dave
 
Upvote 0
Thanks for the help Dave,

I have attached a link to the file on onedrive and all the code below using the vba tags.

The code below all functions fine apart from the "Edit me" sub at the end.

VBA Code: 
Sub AddMe()
'declare the variables
Dim Bws As Worksheet
Dim Fws As Worksheet
Dim Dt As Range
Dim Rm As Range
Dim ID As Range
Dim CK As Range
Dim orange As Range
Dim lastrow As Long
Dim nextrow As Range
'turn off screen updating
Application.ScreenUpdating = False
'variables
Set Bws = Sheet2
Set Fws = Sheet4
Set Dt = Bws.Range("V4")
Set Rm = Bws.Range("V3")
Set ID = Fws.Range("B5")
Set CK = Fws.Range("BM6")

On Error GoTo errHandler:
'check for sufficent data
If Bws.Range("V4").Value = "" Or Bws.Range("V3").Value = "" Or Bws.Range("An3").Value = "" Then
MsgBox "There is insufficient data to add"
Exit Sub
End If
'run the filter to check for duplicates
AdvChk
'if duplicate exist then stop and inform user
If CK.Value > 0 Then
MsgBox "This name or date already exists .This is a duplicate"
Exit Sub
End If
'find the next free row
Set nextrow = Fws.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
With nextrow
.Offset(0, -1).Value = ID.Value + 1
.Value = Bws.Range("V3").Value
.Offset(0, 1).Value = Bws.Range("V4").Value
.Offset(0, 2).Value = Bws.Range("V5").Value
.Offset(0, 3).Value = Bws.Range("V6").Value
.Offset(0, 4).Value = Bws.Range("V7").Value
.Offset(0, 5).Value = Bws.Range("AE3").Value
.Offset(0, 6).Value = Bws.Range("AE4").Value
.Offset(0, 7).Value = Bws.Range("AE5").Value
.Offset(0, 8).Value = Bws.Range("AE7").Value
.Offset(0, 9).Value = Bws.Range("AN3").Value
.Offset(0, 10).Value = Bws.Range("AN4").Value
.Offset(0, 11).Value = Bws.Range("AN5").Value
.Offset(0, 12).Value = Bws.Range("AN6").Value
.Offset(0, 13).Value = Bws.Range("AN7").Value
.Offset(0, 14).Value = Bws.Range("AZ3").Value
.Offset(0, 15).Value = Bws.Range("BD3").Value
.Offset(0, 16).Value = Bws.Range("AZ4").Value
.Offset(0, 17).Value = Bws.Range("BD4").Value
.Offset(0, 18).Value = Bws.Range("AZ5").Value
.Offset(0, 19).Value = Bws.Range("BD5").Value
.Offset(0, 20).Value = Bws.Range("AZ6").Value
.Offset(0, 21).Value = Bws.Range("BD6").Value
.Offset(0, 22).Value = Bws.Range("AZ7").Value
.Offset(0, 23).Value = Bws.Range("BD7").Value
End With
'run the filter to limit data
FilterRng
'select the bookings sheet
Bws.Select
'run the macro to add the bookings
Bookings
'clear the values
Clearme
'error block
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Sub Bookings()
'declare the variables
Dim bCell As Range, Rm As Range, Dt As Range, orange As Range
Dim dCell As Range, aCell As Range, Cl As Range, Nn As Range, ID As Range
Dim Fws As Worksheet, Bws As Worksheet
Dim x As Integer
Dim lastrow As Long
Dim oCell As Variant
Dim iCell As Variant

On Error Resume Next

'variables
Set Fws = Sheet4 'data sheet
Set Bws = Sheet2 'bookings sheet

'filter the data to limit
FilterRng
'set the range to loop through
lastrow = Fws.Range("AJ" & Rows.Count).End(xlUp).Row
Set orange = Fws.Range("AJ9:AJ" & lastrow)
'clear the values from the calendar
Bws.Range("E13:BH40").ClearContents
Bws.Range("E13:BH40").Interior.ColorIndex = xlNone

'LOOP 1"""""""""""""""""""""""""""""""
'set the variable for the number of rows and loop through
For x = 13 To 55
'set the room variable
Set Rm = Bws.Cells(x, 3)

'LOOP 2"""""""""""""""""""""""""""""'
'loop through column range
For Each dCell In Bws.Range(Cells(x, 5), Cells(x, 60))
If Not dCell Is Nothing Then
'set the date variable
Set Dt = Cells(12, dCell.Column)

'FIND FUNCTION""""""""""""""""""""
'find the rooms
Set aCell = orange.Find(What:=Rm, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
'set the room variable
Set bCell = aCell

'LOOP 3"""""""""""""""""""""""
'loop through the filtered data
Do
'find the next room with a booking
Set aCell = orange.FindNext(After:=aCell)
'establish the dates to add
If aCell.Offset(0, 1).Value <= Dt.Value And aCell.Offset(0, 3).Value >= Dt.Value Then
'set the variables
Set Cl = aCell.Cells(1, 5) 'status
Set Nn = aCell.Cells(1, 10) 'name
Set ID = aCell.Offset(0, -1) 'ID
'add the names and reassign after once
If oCell <> Nn Or iCell <> ID Then
dCell.Value = Nn
Set oCell = Nn
Set iCell = ID
End If
'add the coloring
Select Case Cl
Case "Unconfirmed"
dCell.Interior.ColorIndex = 27
Case "Confirmed"
dCell.Interior.ColorIndex = 24
Case "Paid"
dCell.Interior.ColorIndex = 4
Case "Cancelled"
dCell.Interior.ColorIndex = 38
End Select
End If
'exit when values are found
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
Else
Exit Do
End If

Loop 'LOOP 3 end

End If
End If

Next dCell 'LOOP 2 end

Next x 'LOOP 1 end

On Error GoTo 0
End Sub
Sub LookUp()
'declare the variable
Dim Dt As Range, Nn As Range, Rm As Range
Dim c As Range, orange As Range
Dim lastrow As Long
'set object variables
Set Nn = ActiveCell
Set Dt = Cells(12, Nn.Column)
Set Rm = Cells(Nn.Row, 3)
'set the variable range to loop through
lastrow = Sheet4.Range("D" & Rows.Count).End(xlUp).Row
Set orange = Sheet4.Range("D9:D" & lastrow)
'error handler
On Error GoTo errHandler:
'establish data is there and loop
If Not Range("E13:BH40") Is Nothing Then
For Each c In orange 'add dynamic range
'1. has a value 2.Verify Room 3.Look in date range 4. Check the name [optional]
If c.Value <> 0 And c.Offset(0, -1) = Rm.Value And c.Value <= Dt.Value And c.Offset(0, 2).Value >= Dt.Value Then 'And c.Offset(0, 8).Value = Nn
'add the values selectively to the top of the calendar
With Sheet2
.Range("H3").Value = c.Cells(1, -1).Value
.Range("V3").Value = c.Cells(1, 0).Value
.Range("V4").Value = c.Value
.Range("V5").Value = c.Cells(1, 2).Value
'.Range("V6").Value = c.Cells(1, 3).Value 'end date calculated do not send
.Range("V7").Value = c.Cells(1, 4).Value
.Range("AE3").Value = c.Cells(1, 5).Value
.Range("AE4").Value = c.Cells(1, 6).Value
.Range("AE5").Value = c.Cells(1, 7).Value
'.Range("AE6").Value 'calculated value not available in data
'.Range("AE7").Value = c.Cells(1, 8).Value 'total calculated do not send
.Range("AN3").Value = c.Cells(1, 9).Value
.Range("AN4").Value = c.Cells(1, 10).Value
.Range("AN5").Value = c.Cells(1, 11).Value
.Range("AN6").Value = c.Cells(1, 12).Value
.Range("AN7").Value = c.Cells(1, 13).Value
.Range("AZ3").Value = c.Cells(1, 14).Value
.Range("BD3").Value = c.Cells(1, 15).Value
.Range("AZ4").Value = c.Cells(1, 16).Value
.Range("BD4").Value = c.Cells(1, 17).Value
.Range("AZ5").Value = c.Cells(1, 18).Value
.Range("BD5").Value = c.Cells(1, 19).Value
.Range("AZ6").Value = c.Cells(1, 20).Value
.Range("BD6").Value = c.Cells(1, 21).Value
.Range("AZ7").Value = c.Cells(1, 22).Value
.Range("BD7").Value = c.Cells(1, 23).Value

End With
End If
Next c
End If
'error block
On Error GoTo 0
Exit Sub
errHandler::
MsgBox "An Error has Occurred " & vbCrLf & "The error number is: " _
& Err.Number & vbCrLf & Err.Description & vbCrLf & _
"Please notify the administrator"
End Sub
Sub DeleteMe()
'declare the variables
Dim ID As Range, c As Range, orange As Range
Dim lastrow As Long
'set the object variable
Set ID = Sheet2.Range("H3")
'stop screen flicker
Application.ScreenUpdating = False
lastrow = Sheet4.Range("B" & Rows.Count).End(xlUp).Row
Set orange = Sheet4.Range("B9:B" & lastrow)
'find the value in the range
For Each c In orange
If c.Value = ID.Value Then
'delete the row
c.EntireRow.Delete
'sort the data
Sortit
End If
Next c
'et go home
Sheet2.Select
'update the calendar
Bookings
End Sub

Sub EditMe()
  'declare the variables
  Dim Bws As Worksheet, Fws As Worksheet, nextrow As Range
  'turn off screen updating
  Application.ScreenUpdating = False
  'variables
  Set Bws = Sheet2
  Set Fws = Sheet4
  'check for sufficent data
  If Bws.Range("V4").Value = "" Or Bws.Range("V3").Value = "" Or Bws.Range("An3").Value = "" Then
      MsgBox "There is insufficient data to add"
      Exit Sub
  End If
  'find the next free row
  Set nextrow = Fws.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
  With nextrow
    If .Offset(0, -1).Value = Bws.Range("h3").Value Then
      .Value = Bws.Range("V3").Value
      .Offset(0, 1).Value = Bws.Range("V4").Value
      .Offset(0, 2).Value = Bws.Range("V5").Value
      .Offset(0, 3).Value = Bws.Range("V6").Value
      .Offset(0, 4).Value = Bws.Range("V7").Value
      .Offset(0, 5).Value = Bws.Range("AE3").Value
      .Offset(0, 6).Value = Bws.Range("AE4").Value
      .Offset(0, 7).Value = Bws.Range("AE5").Value
      .Offset(0, 8).Value = Bws.Range("AE7").Value
      .Offset(0, 9).Value = Bws.Range("AN3").Value
      .Offset(0, 10).Value = Bws.Range("AN4").Value
      .Offset(0, 11).Value = Bws.Range("AN5").Value
      .Offset(0, 12).Value = Bws.Range("AN6").Value
      .Offset(0, 13).Value = Bws.Range("AN7").Value
      .Offset(0, 14).Value = Bws.Range("AZ3").Value
      .Offset(0, 15).Value = Bws.Range("BD3").Value
      .Offset(0, 16).Value = Bws.Range("AZ4").Value
      .Offset(0, 17).Value = Bws.Range("BD4").Value
      .Offset(0, 18).Value = Bws.Range("AZ5").Value
      .Offset(0, 19).Value = Bws.Range("BD5").Value
      .Offset(0, 20).Value = Bws.Range("AZ6").Value
      .Offset(0, 21).Value = Bws.Range("BD6").Value
      .Offset(0, 22).Value = Bws.Range("AZ7").Value
      .Offset(0, 23).Value = Bws.Range("BD7").Value
    End If
  End With
  FilterRng   'run the filter to limit data
  Bws.Select  'select the bookings sheet
  Bookings    'run the macro to add the bookings
  Clearme     'clear the values
End Sub

Copy of Room Booking System
 
Upvote 0
link is asking to sign-in need to make access public is possible

Dave
 
Upvote 0
dmt32 said:
cannot see download option?

Dave
Click to expand...
If you open the link and click on file > download > microsoft excel, you should be able to open the file in excel.

Let me know if you can see those options and thanks again for your help.
1640701216844.png
 
Upvote 0
None of the shape buttons seem to do anything but that aside, Looking at your EditMe code the line shown in BOLD I needs to be assigned the row you want updating

You would do this in the lookup code after you have found required record - e.g.

Set NextRow = c

where c is your range variable which the declaration will need to be moved from within the lookup procedure to the very TOP of the module code page to make it available to the EditMe procedure.

VBA Code: 
Dim c As Range

Rich (BB code): 
Sub EditMe()
  'declare the variables
  Dim Bws As Worksheet, Fws As Worksheet, nextrow As Range
  'turn off screen updating
  Application.ScreenUpdating = False
  'variables
  Set Bws = Sheet2
  Set Fws = Sheet4
  'check for sufficent data
  If Bws.Range("V4").Value = "" Or Bws.Range("V3").Value = "" Or Bws.Range("An3").Value = "" Then
      MsgBox "There is insufficient data to add"
      Exit Sub
  End If
  'find the next free row
  Set nextrow = Fws.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

Hopefully, this will resolve your issue

Dave
 
Upvote 0
Solution
dmt32 said:
None of the shape buttons seem to do anything but that aside, Looking at your EditMe code the line shown in BOLD I needs to be assigned the row you want updating

You would do this in the lookup code after you have found required record - e.g.

Set NextRow = c

where c is your range variable which the declaration will need to be moved from within the lookup procedure to the very TOP of the module code page to make it available to the EditMe procedure.

VBA Code: 
Dim c As Range

Rich (BB code): 
Sub EditMe()
  'declare the variables
  Dim Bws As Worksheet, Fws As Worksheet, nextrow As Range
  'turn off screen updating
  Application.ScreenUpdating = False
  'variables
  Set Bws = Sheet2
  Set Fws = Sheet4
  'check for sufficent data
  If Bws.Range("V4").Value = "" Or Bws.Range("V3").Value = "" Or Bws.Range("An3").Value = "" Then
      MsgBox "There is insufficient data to add"
      Exit Sub
  End If
  'find the next free row
  Set nextrow = Fws.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)

Hopefully, this will resolve your issue

Dave
Click to expand...
That’s solved my issue , the edit booking button now allows me to change recorded data such as move a booking from room 5 to 10.

Thanks a lot for your help Dave , really appreciate it.
 
Upvote 0
welcome - glad issue resolved & appreciate feedback

Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
From two dates, dividing the years into different columns, create hyperlinks organized by quantity and not by dates
Replies
0
Views
145
ExcelenteNovel
E
J
  • Question
Need to work out occupancy rate and to filter
Replies
2
Views
133
awoohaw
awoohaw
hendrikbez
  • Question
Cannot get to edit on my user form with 1 to 5 members on it
Replies
1
Views
62
Anthony47
A
I
  • Question
Show the "Edit Name" dialog from VBA for a specific Name
Replies
1
Views
366
Jaafar Tribak
Jaafar Tribak
J
  • Locked
  • Question
Forms Interconnection
Replies
1
Views
146
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,215,043
Messages
6,122,816
Members
449,095
Latest member
m_smith_solihull

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