Edit and Apply Changes to Existing Field

M

Mnet22

New Member
Joined
Sep 17, 2017
Messages
37
Dear Excel Users - I'm busy to learn how to do a cabin booking system. Just to explain how the worksheet works - I have two sheets - Sheet 2 shows a calendar where cabins can be booked . In sheet 4 it shows the variable date range and will only show the data that is between the dates selected.It runs multiple loops and using the find function to speed up the looping process.

On Sheet 2 there is 5 Buttons - Add a new booking, Lookup a booking, delete a booking, edit existing booking and clear fields (Orange buttons) - All works perfectly but I need a script to EDIT EXISTING BOOKING. For Example on the calendar click on an pre-existing booking - the detail of the booking is now displayed, one now needs to do changes for example change the arrival date or status of the booking and now press the "edit existing booking" to apply the changes. Any help will be highly appreciated!! Please see the existing code below -

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 40
'set the cabin 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 cabin
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 Cabin variable
Set bCell = aCell

'LOOP 3"""""""""""""""""""""""
'loop through the filtered data
Do
'find the next Cabin 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 Cabin 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
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
I have created the following script but it is still not working?
Code: 
Sub Editme()
    Dim orange As Range, Dt As Range, Nn As Range
    Dim Rm As Range, Tp As Range, ID As Range, c As Range
    Dim Bws As Worksheet, Fws As Worksheet
    Dim LastRow As Long

    Set Bws = Sheet2
    Set Fws = Sheet4
    Set Dt = Bws.Range("V4")
    Set Rm = Bws.Range("V3")
    Set Tp = Bws.Range("V7")
    Set Nn = Bws.Range("AN3")
    Set ID = Bws.Range("H3")
    Application.ScreenUpdating = False
    LastRow = Fws.Range("B" & Rows.Count).End(xlUp).Row
    Set orange = Fws.Range("B9:B" & LastRow)
    If Dt.Value = "" Or Rm.Value = "" Or Tp.Value = "" Or Nn.Value = "" Then
        MsgBox "There is insufficient data to add"
        Exit Sub
    End If
    For Each c In orange
        If c.Offset(0, -1).Value = ID.Value Then
            c.Value = Rm.Value
            c.Offset(0, 1).Value = Dt.Value
            c.Offset(0, 2).Value = Tp.Value
            c.Offset(0, 3).Value = Nn.Value
            Bookings
        End If
    Next c
    Bookings
    Clearme
End Sub

Please note that I have put this Problem forward in the Excel Forum with No Solution - https://www.excelforum.com/excel-programming-vba-macros/1204855-edit-selected-fields.html
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
Using pattern searches with a variable to find the correct values
2
Replies
10
Views
197
chazrab
C
B
  • Solved
VBA to check if worksheet exists
Replies
8
Views
314
bdt
B
O
  • Solved
VBA Code to Find Duplicate Values in a Range and Add a Number at the End
2
Replies
12
Views
664
OilEconomist
O
D
  • Question Question
VBA Code to Apply an AVERAGE of a Range on Cells as New Records are added Via a User Form
Replies
2
Views
72
Denny57
D
M
  • Solved
Deleting rows from a Range variable
Replies
4
Views
273
Umma123
U

Forum statistics

Threads
1,223,908
Messages
6,175,304
Members
452,633
Latest member
DougMo

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