Updating edited information in form with VBA

O

oblix

Board Regular
Joined
Mar 29, 2017
Messages
183
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
  5. 2013
  6. 2011
  7. 2010
  8. 2007
  9. 2003 or older
Platform
  1. Windows
  2. MacOS
  3. Mobile
  4. Web
I have a booking database
on the one sheet have button to update edited data
have created sub edit me under assorted module
but code not working


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 40
        '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 'days calculated do not send
                    .Range("V6").Value = c.Cells(1, 3).Value
                    .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
    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 = Bws.Range("h3")
    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
    'find the next free row
    Set nextrow = Fws.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0)
    With nextrow
        If .Offset(0, -1).Value = ID.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
    '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
 
Last edited by a moderator:
Sort by date Sort by votes
Thank you
I am so knew at this don't even know where to go to post new thread
What could the heading be for this new thread?
 
Last edited:
Upvote 0

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
In that field, start typing the thread title. In the title write any text related to your problem.

1576784021257.png
 
Upvote 0
new thread created:
www.mrexcel.com

Checking in and out for booking system with VBA Code

I have a booking system that populates the names of guests in the form of a gantt style reservation chart. Each date has two columns for same date. Currently if i book a person with arrival and departure date, it populates both columns. I would like for the arrival to populate the second...
www.mrexcel.com www.mrexcel.com
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Solved
Would like to make edits to VBA Calendar Code
Replies
8
Views
376
Legacy 352679
L
I
  • Question
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
238
ItalianPlatinum
I
KlausW
  • Solved
Run VBA one after the other
Replies
8
Views
196
Joe4
Joe4
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
193
bobaol
B
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
312
sspatriots
S

Forum statistics

Threads
1,214,621
Messages
6,120,568
Members
448,972
Latest member
Shantanu2024

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