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:

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
The problem is in the sub "EditMe"?
That sub has these problems:
- Missing sub FilterRng
- Missing sub Clearme
- Missing "End If" statement
- Missing "End With" statement

- They suggested that you delete the instruction: "On Error GoTo errHandler:"
- 'If you do not occupy these objects, then it is not necessary to declare them.
'Dim Dt As Range
'Dim Rm As Range
'Dim ID As Range
'Dim CK As Range
'Dim orange As Range
'Dim LastRow As Long

______________________________________________
Try this.
If the macro sends an error, you should put the message here and which line of the macro stops.
If the macro has a logic problem, that is, it is not putting the data in the right place, you should explain with an example what the macro should do.

VBA 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)
  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
 
Upvote 0
Code does not give any errors but does not update the booking or data sheet.
Is there a way to send someone the file to test?
 
Upvote 0
oblix said:
Code does not give any errors but does not update the booking or data sheet.
Is there a way to send someone the file to test?
Click to expand...
If the macro has a logic problem, that is, it is not putting the data in the right place, you should explain with an example what the macro should do.
 
Upvote 0
on the booking sheet if i click on an existing booking (eg: jane) ny using the lookup button. it populates rows 3 to 7.
if I change room no or any other data from v - bh and i click on edit button (running editme macro) it should:
Upate the booking on booking sheet (eg jane change departure date)
and update info on data sheet.
 

Attachments

  • booking page.png
    booking page.png
    69.7 KB · Views: 8
  • data_sheet.png
    data_sheet.png
    49.8 KB · Views: 6
Upvote 0
You can explain how you identify Jane's record among all the records you have on the "data_sheet" sheet .

I guess, looking for the ID (cell H3) in column "B" of the "data_sheet" sheet.

If the above is correct, then try this:

VBA Code: 
Sub EditMe()
  'declare the variables
  Dim Bws As Worksheet, Fws As Worksheet, f As Range, wID As Variant
  'turn off screen updating
  Application.ScreenUpdating = False
  'variables
  Set Bws = Sheet2
  Set Fws = Sheet4
  'check for sufficent data
  If Bws.Range("H3").Value = "" Or Bws.Range("V3").Value = "" Or _
     Bws.Range("V4").Value = "" Or Bws.Range("AN3").Value = "" Then
      MsgBox "There is insufficient data to Edit"
      Exit Sub
  End If
  'find ID
  wID = Bws.Range("H3").Value
  Set f = Fws.Range("B9:B" & Fws.Range("B" & Rows.Count).End(xlUp).Row).Find(wID, , xlValues, xlWhole)
  If f Is Nothing Then
    MsgBox "ID does not exists"
    Exit Sub
  End If
  With f
    .Offset(0, 1).Value = Bws.Range("V3").Value
    .Offset(0, 2).Value = Bws.Range("V4").Value
    .Offset(0, 3).Value = Bws.Range("V5").Value
    .Offset(0, 4).Value = Bws.Range("V6").Value
    .Offset(0, 5).Value = Bws.Range("V7").Value
    .Offset(0, 6).Value = Bws.Range("AE3").Value
    .Offset(0, 7).Value = Bws.Range("AE4").Value
    .Offset(0, 8).Value = Bws.Range("AE5").Value
    .Offset(0, 9).Value = Bws.Range("AE7").Value
    .Offset(0, 10).Value = Bws.Range("AN3").Value
    .Offset(0, 11).Value = Bws.Range("AN4").Value
    .Offset(0, 12).Value = Bws.Range("AN5").Value
    .Offset(0, 13).Value = Bws.Range("AN6").Value
    .Offset(0, 14).Value = Bws.Range("AN7").Value
    .Offset(0, 15).Value = Bws.Range("AZ3").Value
    .Offset(0, 16).Value = Bws.Range("BD3").Value
    .Offset(0, 17).Value = Bws.Range("AZ4").Value
    .Offset(0, 18).Value = Bws.Range("BD4").Value
    .Offset(0, 19).Value = Bws.Range("AZ5").Value
    .Offset(0, 20).Value = Bws.Range("BD5").Value
    .Offset(0, 21).Value = Bws.Range("AZ6").Value
    .Offset(0, 22).Value = Bws.Range("BD6").Value
    .Offset(0, 23).Value = Bws.Range("AZ7").Value
    .Offset(0, 24).Value = Bws.Range("BD7").Value
  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
 
Upvote 0
Thank you Dante
as a beginner I have been struggling with this spread sheet for over a month.
The solution above solved one of my last few issues.

Thanks once again and happy holidays
 
Upvote 0
I am hopping you can help with this one:
Every date on booking chart has two columns, is it possible for arrival date to be populated on second column of each date, and departure date in the first column of each date?
The idea is that one person can leave and another arrive on same date in same room.
 
Upvote 0
oblix said:
I am hopping you can help with this one:
Every date on booking chart has two columns, is it possible for arrival date to be populated on second column of each date, and departure date in the first column of each date?
The idea is that one person can leave and another arrive on same date in same room.
Click to expand...
I am glad to help you, but this is a different topic to this thread.
I suggest that you create a new thread, and you should put examples explaining in detail what you have and what you expect from the result.

happy holidays ?
 
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
396
Legacy 352679
L
hendrikbez
  • Question
Cannot get to edit on my user form with 1 to 5 members on it
Replies
1
Views
59
Anthony47
A
I
  • Question
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
252
ItalianPlatinum
I
KlausW
  • Solved
Run VBA one after the other
Replies
8
Views
201
Joe4
Joe4
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
204
bobaol
B

Forum statistics

Threads
1,214,827
Messages
6,121,823
Members
449,049
Latest member
cybersurfer5000

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