How to prevent duplicate entry in database?

[joshidharmesh101]

Hello,

I am working on a cinema hall booking project. At many places I have to prevent duplicate entries. I am running a string to find out if there is any previous entry or not. I am running following code

---

Private Sub cmdSave_Click()
Dim Sev As New ADODB.Recordset

Str = "Select * from Movie_Time where 'Mov_Name' = '" & cboMovie.Text & "' and 'screen' = '" & cboScreenName.Text & "' and 'cls' = '" & cboClass.Text & "' and 'Mov_Time' = '" & cboMovieTime.Text & "' and Week_StDate = " & StDate.Value & " and Week_EnDate = " & EnDate.Value & ""
'CN.Execute Str
Sev.Open Str, CN, adOpenDynamic, adLockPessimistic
MsgBox Str & vbCrLf & Sev.RecordCount, vbOKOnly

If Sev.RecordCount > 0 Then
End If
If Sev.EOF = False Then
MsgBox "This Entry is Already Added", vbOKOnly, "Duplicate Entry!!!"
Sev.Close
Exit Sub
End If
Sev.Close
Sev.Open "Select * from Movie_Time", CN, adOpenDynamic, adLockPessimistic
If Not Sev.EOF Then Sev.MoveLast
Sev.AddNew
Sev.Fields("Mov_Name") = cboMovie.Text
Sev.Fields("Screen") = cboScreenName.Text
Sev.Fields("Cls") = cboClass.Text
Sev.Fields("Mov_Time") = cboMovieTime.Text
Sev.Fields("Price") = txtPrice.Text
Sev.Fields("Week_StDate") = Format$(StDate.Value, "MM/DD/YY")
Sev.Fields("Week_EnDate") = Format$(EnDate.Value, "MM/DD/YY")
Sev.Update
Sev.Close
MsgBox "Movie Time Saved Succesfully", vbInformation + vbOKOnly
frmNewMovie.Mov_Display
Unload Me


End Sub

---

All fields in database are text except Week_StDate & Week_EnDate which are Date/Time

Even when the table is not empty, when open the database with Sev.Open"Select * from Movie_Time",CN,AdOpenDynamic,AdLockPessimistic & pass a line with Sev.Recordcount I get -1 as result.

Please help.

Thanks,

Dharmesh Joshi

[LaVolpe]

Welcome to the forums

Don't rely on the .RecordCount property. Depending on which cursor type you use (server side usually) when connecting to DB/RS, it may return -1 instead of an actual count. To see if any records are returned: If .EOF = True And .BOF = True

If you need to the actual record count, I think you can .MoveLast then .RecordCount returns the correct value; but not 100% positive about that.

[joshidharmesh101]

Thanks LaVolpe for the response.

I am using LaVolpeButtons in all my projects. Thanks for those lovely button controls, too.

BTW, looking at above code, do you smell something fishy?

Dharmesh Joshi

[Elroy]

Hi joshidharmesh101,

I didn't study your code above, but I do a tremendous amount of work with VB6 and MS-Access databases. To begin with, I'd like to second what LaVolpe stated about the .RecordCount property. I've never found it to lie about the presence (or lack) of records. In other words, I've always found it to be truthful when used as a boolean (there are records versus there aren't records). However, it's often quite unreliable when asking it to tell you the exact number of records.

Regarding your question about duplicates, in these cases, I always create an index on the field for which I don't want duplicates. If you create the index to "have no dupes", then you can either use error trapping or the .Seek method to check. Personally, I'd strongly recommend the .Seek method over error trapping, as I don't like error trapping when there's an obvious solution without using it.

Just saying how I'd do it.

Best Regards,
Elroy

[DataMiser]

I altered the code posted in the OP removing the extra select statement exit sub, record count and extra close statement.

Give it a try

Private Sub cmdSave_Click()
    Dim Sev As ADODB.Recordset
    Set Sev = New ADODB.Recordset
    
    Str = "Select * from Movie_Time where 'Mov_Name' = '" & cboMovie.Text & "' and 'screen' = '" & cboScreenName.Text & "' and 'cls' = '" & cboClass.Text & "' and 'Mov_Time' = '" & cboMovieTime.Text & "' and Week_StDate = " & StDate.Value & " and Week_EnDate = " & EnDate.Value & ""
    Debug.Print Str
    Sev.Open Str, CN, adOpenDynamic, adLockPessimistic
    If Sev.EOF Then
        Sev.AddNew
        Sev.Fields("Mov_Name") = cboMovie.Text
        Sev.Fields("Screen") = cboScreenName.Text
        Sev.Fields("Cls") = cboClass.Text
        Sev.Fields("Mov_Time") = cboMovieTime.Text
        Sev.Fields("Price") = txtPrice.Text
        Sev.Fields("Week_StDate") = Format$(StDate.Value, "MM/DD/YY")
        Sev.Fields("Week_EnDate") = Format$(EnDate.Value, "MM/DD/YY")
        Sev.Update
        Sev.Close
        MsgBox "Movie Time Saved Succesfully", vbInformation + vbOKOnly
        frmNewMovie.Mov_Display
        Unload Me
    Else
        MsgBox "This Entry is Already Added", vbOKOnly, "Duplicate Entry!!!"
        Sev.Close
    End If
   
End Sub

[Phill.W]

The typical way of ensuring uniqueness is a database is to use a Composite Key or a unique index across multiple fields.

In this case, I think that's Mov_Name, Screen and Mov_Time.
Create a unique index on these three fields.

Then your application no longer needs to worry about checking for duplicates because the database simply won't allow then. Also, in a truly multi-user environment (which Access isn't) this is the only reliable way of doing this check; reading and then inserting based on the outcome can result in what's called a "Race Condition" where two competing processes do the same things in the same order at [almost] the same time and both of them succeed. With the database protecting itself, this cant happen.

Regards, Phill W.

[techgnome]

I glossed over everything after I read that you got a -1 ... so this may be repeat info... if you're getting -1 it means that there are rows, but because it is server-side cursor, ADO does NOT know how many rows there are.
To be honest, if all you're interested int knowing is if there are rows or not... then use a select count(*) instead. Just return the count don't bother returning all the rows. As long as there is data in the table you'll always get a row back and it'll have the count of the rows that matched which should be 0 (meaning no rows matched) or >=1 (meaning one or more rows matched). I see Phill's remark about a primary key and I agree... but I don't like to rely solely on that because it cause errors to happen and they can be expensive (from a CPU) and sometimes difficult to capture properly. So if it take a split second to be proactive and run a quick query to see if the data is about to be duplicated, then that's a better way to go in my opinion. Now, that's not to say you shouldn't add a PKey index, you should, but you shouldn't rely on that being the sole means of deduping the data.

-tg

[ChrisE]

Hi,

it might be helpful to visualize the rows and seats of the cinema with a Flexgrid?

Private Sub Form_Load()
 Dim i As Long
   
      With MSFlexGrid1
         .Rows = 50
         .Cols = 50
         .FixedCols = 0
         .FocusRect = flexFocusHeavy
         
         For i = 0 To .Cols - 1
            .TextMatrix(0, i) = "Row " & i + 1
         Next
         
         For i = .FixedRows To .Rows - 1
            .TextMatrix(i, 0) = "Seat " & i
            .TextMatrix(i, 1) = "Seat " & i
            .TextMatrix(i, 4) = "Seat " & i
         Next
      End With
End Sub

Private Sub MSFlexGrid1_RowColChange()
With MSFlexGrid1
Row = .Row
Col = .Col
Text1.Text = "your row" & .Col + 1 & " your seat" & .Row

End With

End Sub

regards
Chris

[Spooman]

,,, deduping the data.

-tg

D'oh

[dilettante]

Define a check constraint on the table, something like:

CONSTRAINT ccUnique UNIQUE(Mov_Name,Screen,Mov_Time,Week_StDate,Week_EnDate)

Span as few fields as it takes to make each entry unique. The check constraint expression that follows its name is limited to 64 characters long in Jet and ACE SQL, other DBMSs may have other limitations.

This can be defined in SQL DDL as part of the table definition or via a subsequent ADD CONSTRAINT.


If your teacher has given an assignment like this then most likely the topic was already covered in lecture or in reading assignments and you are expected to use it instead of hackish alternatives.

[joshidharmesh101]

Thanks all for the replies.

Let me clarify that assigning a primary key to avoid duplicates is not possible because every field can be duplicated. I want to avoid duplicate entries of combination of all parameters.

I am not a programming person & have learnt VB out of curiosity so my knowledge is limited to what I have gained from code examples from different forums & what I have worked with. Please bear with my limited knowledge.

Let us talk about business. I tried to run code suggested by DataMiser but it did not prevent duplicate entry. So I modified the opening string as in following code.

Private Sub cmdSave_Click()
Dim Sev As New ADODB.Recordset
Set Sev = New ADODB.Recordset

Str = "select * from Movie_Time where  Mov_Name   =  " & cboMovie.Text & " And  Screen = " & cboScreenName.Text & " And    cls    = " & cboClass.Text & " And   Mov_Time  = " & cboMovieTime.Text & " And  Week_StDate  = " & StDate.Value & " And  Week_EnDate =  " & EnDate.Value & ""

Debug.Print Str

Sev.Open Str, CN, adOpenDynamic, adLockPessimistic
MsgBox Str & vbCrLf & Sev.RecordCount, vbOKOnly

'If Sev.RecordCount > 0 Then
'End If
'If Sev.EOF = False Then
'    MsgBox "This Entry is Already Added", vbOKOnly, "Duplicate Entry!!!"
'    Sev.Close
'    Exit Sub
'End If
'Sev.Close
'Sev.Open "Select * from Movie_Time", CN, adOpenDynamic, adLockPessimistic
'Sev.Open Str, CN, adOpenDynamic, adLockPessimistic

    If Sev.EOF Then
            MsgBox "This Entry is Already Added", vbOKOnly, "Duplicate Entry!!!"
            Sev.Close
        Exit Sub
    Else
    Sev.MoveLast
    Sev.AddNew
    Sev.Fields("Mov_Name") = cboMovie.Text
    Sev.Fields("Screen") = cboScreenName.Text
    Sev.Fields("Cls") = cboClass.Text
    Sev.Fields("Mov_Time") = cboMovieTime.Text
    Sev.Fields("Price") = txtPrice.Text
    Sev.Fields("Week_StDate") = Format$(StDate.Value, "MM/DD/YY")
    Sev.Fields("Week_EnDate") = Format$(EnDate.Value, "MM/DD/YY")
    Sev.Update
    Sev.Close
    End If
MsgBox "Movie Time Saved Succesfully", vbInformation + vbOKOnly
frmNewMovie.Mov_Display
Unload Me


End Sub

Running this code gives me error as in attached picture.



Even changing properties of Week_StDate & Week_EnDate field properties from Date/Time to Text in database did not solve the error.

Thanks for all the help you are offering me.

Dharmesh Joshi

[techgnome]

Even changing properties of Week_StDate & Week_EnDate field properties from Date/Time to Text in database

Don't do that. Ever. Treat dates as dates.
The reason your SQL didn't work is because it came out like this: Week_StDate = 08/25/17 ... which, when WE see it, looks like a date, because we apply human reading and context to it... but to a computer, it's a mathematical equasion of 8 divided by 25 divided by 17 ..... hmmm... I see that the problem is actually triggered before that.... it all starts with the Mov_Name ... when you compare something to a string, the string needs to be in tick marks so that SQL knows you mean string as opposed to an object or a function or something else... it hit the word "Hero" and it goes "I don't know what the heck hero is... soo.... syntax error".... Also dates and times (as long as they remain typed correctly) should be marked as such, in Access it uses #
So your code should look like this:

Str = "select * from Movie_Time where  Mov_Name   =  '" & cboMovie.Text & "' And  Screen = '" & cboScreenName.Text & "' And    cls    = '" & cboClass.Text & "' And   Mov_Time  = #" & cboMovieTime.Text & "# And  Week_StDate  = #" & StDate.Value & "# And  Week_EnDate =  #" & EnDate.Value & "#"

Personally, I'd store the date and time together, rather than in separate fields. But that's probably just me.

-tg

[techgnome]

Let me clarify that assigning a primary key to avoid duplicates is not possible because every field can be duplicated. I want to avoid duplicate entries of combination of all parameters.

That makes no sense. In one sentence, you're saying they CAN be duplicate, in the next you're saying you want to prevent that. Either they can be duplicated, or they can't. If they can't then creating a Unique PKey index on the columns that can't be duplicated will help. That's what it's for. Take a school. A given class, say Biology can only happen at a given time in a given room - it can happen in other rooms at the same time, it can happen in the same room at other times, it can be at other times in other rooms... but for a specific time and room, there can only be one class happening there... so if I want to prevent two classes from being booked in the same classroom at the same times, I'd create a composite index that includes the ClassID (Biology), the RoomID (Edison Hall, Rm 205), and the TimeSlotID (9:25am-M,W,F) (I wouldn't use the time specifically because they, like strings tend to index poorly)... so now I have an index that covers all three fields. Now I can't insert that same combination into the database. (granted, as I write that, I see other issues with it, but I'm just trying to illustrate a point that I don't see why you can't create a PKey on your table with the fields that you don't want to be duplicated.)

I am not a programming person & have learnt VB out of curiosity so my knowledge is limited to what I have gained from code examples from different forums & what I have worked with. Please bear with my limited knowledge.

That's fine.... we all started somewhere. At least you have the internet. I didn't have that luxury. I had to read books! Eeep!


-tg

[Phill.W]

> "Let me clarify that assigning a primary key to avoid duplicates is not possible because every field can be duplicated. I want to avoid duplicate entries of combination of all parameters."

A primary key can be made up of any number of fields, the combination of which must be unique. Given a primary key on Mov_name, Screen and Mov_Time, all of these are possible:

+--------------------+----------+----------+
| Mov_Name           | Screen   | Mov_Time | ... 
+--------------------+----------+----------+
| Hero               | Screen-1 | 21:00    | 
| Hero               | Screen-2 | 22:00    | 
| Gulliver's Travels | Screen-2 | 22:00    | 
+--------------------+----------+----------+

Actually, looking it at it like this, the Primary Key probably ought to be on just Screen and Mov_Time because you can't have more than one film showing on any one screen at any one time. Which film is showing is only a secondary concern and so this field doesn't need to be part of the Key.

> "Running this code gives me error as in attached picture ... "

Remember that you are constructing a String that just happens to contain text that your database understands.

You need to wrap character values in single quotes (and double-up any single-quotes within each value) and date values in hash marks:

"Mov_Name = 'Hero' and Screen = 'Screen-1' and Cls = 'Gold' and Mov_Time = '12:00' and Week_StDate = #08/25/17# and Week_EnDate = #08/31/17#"

Nice try with using Format() on the date values but, if your column is already a Date[Time] then it's pointless; you're taking a Date value, turning it into a String, then putting it into a Date[Time] column; all of those implicit type conversions are opportunities for VB and/or Windows to do something stupid in [mis-]interpreting your dates.
When is "01/04/07"? April 1st? January 4th? April 7th [2001]?
All of these are potentially right, depending on where in the World your code gets run.

With your code as it stands, have fun trying to screen "Gulliver's Travels".
(Hint: Double-up single quotes in character values when building your SQL).
(Better Hint: Read up about Parameterised queries).

Regards, Phill W.

[ChrisE]

Hi Phil

Actually, looking it at it like this, the Primary Key probably ought to be on just Screen and Mov_Time because you can't have more than one film showing on any one screen at any one time. Which film is showing is only a secondary concern and so this field doesn't need to be part of the Key.

I don't now about the US Cinemas, but in Germany on the ticket there is Row/Seat number/Date/ and Movie
somtimes there are more then one Cinemas in a Complex.

so if there are pre-bookings, when people like to sit way back(like I do) they ask for a certain seat or row.

just my thought's

regards
Chris

[DataMiser]

Running this code gives me error as in attached picture.

Dharmesh Joshi

This line is wrong

Str = "select * from Movie_Time where  Mov_Name   =  " & cboMovie.Text & " And  Screen = " & cboScreenName.Text & " And    cls    = " & cboClass.Text & " And   Mov_Time  = " & cboMovieTime.Text & " And  Week_StDate  = " & StDate.Value & " And  Week_EnDate =  " & EnDate.Value & ""

Compare it to this one and take notice of the delimiters around each string value

Str = "Select * from Movie_Time where 'Mov_Name' = '" & cboMovie.Text & "' and 'screen' = '" & cboScreenName.Text & "' and 'cls' = '" & cboClass.Text & "' and 'Mov_Time' = '" & cboMovieTime.Text & "' and Week_StDate = " & StDate.Value & " and Week_EnDate = " & EnDate.Value & ""

Of course now that I look closer at it this one also is missing delimiters for the dates at the end [the part in red]


Edit: Now that I look closer still I see delimiters in that second line that should not be there either
You should not have the 's around the field names
You should have the 's around the values for the text fields.

[IkkeEnGij]

i did a quick read trough this topic, and i have to agree with Phill.W
placing a unique constraint on the combination of Screen and Mov_Time (and maybe seat number ?)
is enough to avoid duplicate reservations (if Mov_time is a datetime, and not just a time)

and if this is an access db, and you have difficulties with sql
you could use isam methods (seeking on an index, blazingly fast), to do the check of existence

but what time after time amazes me, is that almost nobody who searches help in these forums, finds it usefull to post a database

[joshidharmesh101]

Thanks all for the responses. I really learn something from each reply.

I did some changes to my code & finally it is working fine. I had to find the way by trial & error just because I am not a professional coder. Below is my final working code. I was missing # around date records & that was my mistake. Below is my final working code.

Private Sub cmdSave_Click()
Dim Sev As New ADODB.Recordset
Set Sev = New ADODB.Recordset
Str = "Select * from Movie_Time where Mov_Name = '" & cboMovie.Text & "' and Screen = '" & cboScreenName.Text & "' and cls = '" & cboClass.Text & "' and Mov_Time = '" & cboMovieTime.Text & "' and Week_StDate = #" & StDate.Value & "# and Week_EnDate = #" & EnDate.Value & "#"
Sev.Open Str, CN, adOpenDynamic, adLockPessimistic
    If Sev.EOF = False Then
            MsgBox "This Entry is Already Added", vbOKOnly, "Duplicate Entry!!!"
            Sev.Close
        Exit Sub
    Else
    Sev.AddNew
    Sev.Fields("Mov_Name") = cboMovie.Text
    Sev.Fields("Screen") = cboScreenName.Text
    Sev.Fields("Cls") = cboClass.Text
    Sev.Fields("Mov_Time") = cboMovieTime.Text
    Sev.Fields("Price") = txtPrice.Text
    Sev.Fields("Week_StDate") = Format$(StDate.Value, "MM/DD/YY")
    Sev.Fields("Week_EnDate") = Format$(EnDate.Value, "MM/DD/YY")
    Sev.Update
    Sev.Close
    End If
MsgBox "Movie Time Saved Succesfully", vbInformation + vbOKOnly
frmNewMovie.Mov_Display
Unload Me
End Sub

My project is going on & will post my queries as I progress.

Thanks all for the time taken to help me.

Dharmesh Joshi

[ChrisE]

Hi Joshi,

I am just curious, I this one cinema room or more ?
I always take a pen and paper and wright the scenarios down that could ocur.

like...
what if a family shows up and want 5 seat's next to each other
what if a prebooking is canceled.
when a prebooking is in place, when do they have to be there before the tickets become invalid( say 20min before the film starts)
etc.....

hope this will get you to think about you project.

regards
Chris

[joshidharmesh101]

Hi Joshi,

I am just curious, I this one cinema room or more ?
I always take a pen and paper and wright the scenarios down that could ocur.

like...
what if a family shows up and want 5 seat's next to each other
what if a prebooking is canceled.
when a prebooking is in place, when do they have to be there before the tickets become invalid( say 20min before the film starts)
etc.....

hope this will get you to think about you project.

regards
Chris

Hi Chris,

This is a multiplex with 2 screens. It does offer seats as per your choice. I have a flowchart on paper & have reached at a point where I am coding booking system with on screen chart of seating arrangement with booking, printing & cancellation. It will be a fun to learn new features.

Dharmesh Joshi

[ChrisE]

Hi Joshi,

well that sounds alot diffrent than just checking for a duplicate entry.

good luck with your project

regards
Chris

[IkkeEnGij]

yes, indeed
and if well implemented you could even do away with the 'read before you write'
because 'unique constraint' and 'read before you write' are reactive systems
and clearly seeing on screen what is free, and what is occupied, and making it impossible to choice occupied
is proactive
and if you make it so there is at the same time a 'unique constraint'
and a 'read before you write'
and a 'impossible to choice the impossible'
then you have a well designed system

[techgnome]

yes, indeed
and if well implemented you could even do away with the 'read before you write'
because 'unique constraint' and 'read before you write' are reactive systems
and clearly seeing on screen what is free, and what is occupied, and making it impossible to choice occupied
is proactive
and if you make it so there is at the same time a 'unique constraint'
and a 'read before you write'
and a 'impossible to choice the impossible'
then you have a well designed system

+1 this


-tg

[ChrisE]

yes, indeed
and if well implemented you could even do away with the 'read before you write'
because 'unique constraint' and 'read before you write' are reactive systems
and clearly seeing on screen what is free, and what is occupied, and making it impossible to choice occupied
is proactive
and if you make it so there is at the same time a 'unique constraint'
and a 'read before you write'
and a 'impossible to choice the impossible'
then you have a well designed system

Hi Ikke,

I was playing aroung with an on screen display what is free or not, there would be a few ways of doing that.
here is one of many...
a Flexgrid is needed

Option Explicit

Private Sub FlexInit(Flex As MSFlexGrid)

   Dim i As Long, j As Long
   
      With Flex
         .Redraw = False
         .Cols = 20 * 8 + 2
         .Rows = 10
         .FixedCols = 2
         .FixedRows = 2
         .Clear
         
         .ColWidth(0) = 1500
         .TextMatrix(1, 0) = "Date 04.08.2017"
         .TextMatrix(1, 1) = "Time"
         
         .TextMatrix(2, 0) = "Jaws"
         .TextMatrix(3, 0) = "Jaws"
         .TextMatrix(4, 0) = "Jaws"
       
         .ColWidth(1) = 1500
         .TextMatrix(2, 1) = "Sunday  12:00 AM"
         .TextMatrix(3, 1) = "Sunday  03:00 PM"
         .TextMatrix(4, 1) = "Sunday  06:00 PM"
     
         For i = 1 To 20
            j = (i - 1) * 8 + 2
            .TextMatrix(0, j) = Format(i, "00") & " Row"
            .TextMatrix(0, j + 1) = Format(i, "00") & " Row"
            .TextMatrix(0, j + 2) = Format(i, "00") & " Row"
            .TextMatrix(0, j + 3) = Format(i, "00") & " Row"
            .TextMatrix(0, j + 4) = Format(i, "00") & " Row"
            .TextMatrix(0, j + 5) = Format(i, "00") & " Row"
            .TextMatrix(0, j + 6) = Format(i, "00") & " Row"
            .TextMatrix(0, j + 7) = Format(i, "00") & " Row"
          
         
            'add more
            
            .TextMatrix(1, j) = "1"
            .TextMatrix(1, j + 1) = "2"
            .TextMatrix(1, j + 2) = "3"
            .TextMatrix(1, j + 3) = "4"
            .TextMatrix(1, j + 4) = "5"
            .TextMatrix(1, j + 5) = "6"
            .TextMatrix(1, j + 6) = "7"
            .TextMatrix(1, j + 7) = "8"
           
            'add more
            .ColAlignment(j) = flexAlignCenterCenter
            .ColAlignment(j + 1) = flexAlignCenterCenter
            .ColAlignment(j + 2) = flexAlignCenterCenter
            .ColAlignment(j + 3) = flexAlignCenterCenter
            .ColAlignment(j + 4) = flexAlignCenterCenter
            .ColAlignment(j + 5) = flexAlignCenterCenter
            .ColAlignment(j + 6) = flexAlignCenterCenter
            .ColAlignment(j + 7) = flexAlignCenterCenter
           
            
            
            .ColWidth(j) = 300
            .ColWidth(j + 1) = 300
            .ColWidth(j + 2) = 300
            .ColWidth(j + 3) = 300
            .ColWidth(j + 4) = 300
            .ColWidth(j + 5) = 300
            .ColWidth(j + 6) = 300
            .ColWidth(j + 7) = 300
            
       
         Next
         .Redraw = True
         
         .MergeCells = flexMergeRestrictRows
         .MergeRow(0) = True
      End With
End Sub

Private Sub Form_Load()
      FlexInit MSFlexGrid1
      

End Sub

regards
Chris

[joshidharmesh101]

Thanks for the replies.

With my ongoing project, I am facing one more challenge. I need to determine index of alphabet. How can I do this in code?

Let me explain the situation. In ticket booking form, I have populated a flexgrid with Rows A to Q & Columns 1 to 28. Now I want to block some cells to mark passages. I want to mark them by black color & disabling those cells for selection.

I have worked with flexgrid in past but this type is new for me.

Thanks,

Dharmesh Joshi

[ChrisE]

Hi,

try this

Private Sub flexUrlaub_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Msg As String
   
      If Button = 2 Then
If flexUrlaub.Row = 2 And flexUrlaub.Col = 2 Then
            Msg = "this cell in this row is blocked "
            MsgBox Msg, vbInformation, "Termin"
            Exit Sub
         End If

end Sub

regards
Chris

[Phill.W]

I need to determine index of alphabet.

Luckily, the ASCII character set is neatly arrange to help you with this:

Dim eLetter as Variant ' String 
For Each eLetter in Split( "A,B,C,X,Y,Z", "," ) 
   Debug.Print Asc( eLetter ) - Asc( "A" ) 
Next

Regards, Phill W.

[joshidharmesh101]

Thanks Chris & Phill for kindness.

Regards,

Dharmesh Joshi

[IkkeEnGij]

thought i'd have a stab at designing a possible visible interface with a flexgrid
fg is a flexgrid

Private Sub Form_Load()
    Dim i As Integer
    With fg
         .ScrollBars = flexScrollBarNone
         .FocusRect = flexFocusHeavy
         .Appearance = flexFlat
         .AllowBigSelection = False
         .Cols = 33 '28 seat columns + 1 row header + 4 pathways
         .Rows = 20 '17 seat rows + 1 column header + 2 pathways
         .Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
         .ColAlignment(-1) = flexAlignCenterCenter
           
         'the column header (3 seat blocks)
         For i = 2 To 10
             .TextMatrix(0, i) = i - 1
         Next
         For i = 12 To 21
             .TextMatrix(0, i) = i - 2
         Next
         For i = 23 To 31
             .TextMatrix(0, i) = i - 3
         Next

        'the row header
         For i = 2 To 18
             .TextMatrix(i, 0) = Chr(64 + i - 1)
         Next
    
        'the 6 pathways
        .FillStyle = flexFillRepeat
        .Row = 1
        .Col = 1
        .ColSel = .Cols - 1
        .CellBackColor = vbGreen
        
        .Row = .Rows - 1
        .Col = 1
        .ColSel = .Cols - 1
        .CellBackColor = vbGreen
            
        .Col = 1
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
        
        .Col = 11
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
    
        .Col = 22
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
        
        .Col = 32
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
    End With
End Sub

Private Sub Form_Resize()
    With fg
         .Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
         For i = 0 To .Cols - 1
             .ColWidth(i) = Me.ScaleWidth / .Cols
         Next
         For i = 0 To .Rows - 1
             .RowHeight(i) = Me.ScaleHeight / .Rows
         Next
    End With
End Sub

Private Sub fg_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With fg
         .Col = .MouseCol
         .Row = .MouseRow
    End With
    ShowSeatStatus
End Sub

Private Sub fg_DblClick()
    With fg
         If .Row = 0 Or .Col = 0 Or .CellBackColor = vbGreen Then Exit Sub
         If .CellBackColor = vbRed Then
            'make seat available again (maybe ask for confirmation ?)
            .CellBackColor = vbWhite
         Else
            'make seat reserved (maybe ask for confirmation ?)
            .CellBackColor = vbRed
          End If
    End With
    ShowSeatStatus
End Sub

Private Sub ShowSeatStatus()
    Dim TheCaption As String
    With fg
         Select Case .CellBackColor
                Case vbGreen
                     .MousePointer = flexNoDrop
                     TheCaption = "Pathway"
                Case Else
                     .MousePointer = flexDefault
                     If .Row = 0 Or .Col = 0 Then
                         TheCaption = "Header"
                     Else
                         TheCaption = "Seat " & .TextMatrix(.Row, 0) & "-" & .TextMatrix(0, .Col)
                         If .CellBackColor = vbRed Then
                            TheCaption = TheCaption & " Reserved"
                         Else
                            TheCaption = TheCaption & " Free"
                        End If
                     End If
         End Select
    End With
    Me.Caption = TheCaption
End Sub

not extensively tested and no attempt made to link to a database
in fact, i do not clearly 'see' the database

[ChrisE]

thought i'd have a stab at designing a possible visible interface with a flexgrid
fg is a flexgrid

Private Sub Form_Load()
    Dim i As Integer
    With fg
         .ScrollBars = flexScrollBarNone
         .FocusRect = flexFocusHeavy
         .Appearance = flexFlat
         .AllowBigSelection = False
         .Cols = 33 '28 seat columns + 1 row header + 4 pathways
         .Rows = 20 '17 seat rows + 1 column header + 2 pathways
         .Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
         .ColAlignment(-1) = flexAlignCenterCenter
           
         'the column header (3 seat blocks)
         For i = 2 To 10
             .TextMatrix(0, i) = i - 1
         Next
         For i = 12 To 21
             .TextMatrix(0, i) = i - 2
         Next
         For i = 23 To 31
             .TextMatrix(0, i) = i - 3
         Next

        'the row header
         For i = 2 To 18
             .TextMatrix(i, 0) = Chr(64 + i - 1)
         Next
    
        'the 6 pathways
        .FillStyle = flexFillRepeat
        .Row = 1
        .Col = 1
        .ColSel = .Cols - 1
        .CellBackColor = vbGreen
        
        .Row = .Rows - 1
        .Col = 1
        .ColSel = .Cols - 1
        .CellBackColor = vbGreen
            
        .Col = 1
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
        
        .Col = 11
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
    
        .Col = 22
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
        
        .Col = 32
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
    End With
End Sub

Private Sub Form_Resize()
    With fg
         .Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
         For i = 0 To .Cols - 1
             .ColWidth(i) = Me.ScaleWidth / .Cols
         Next
         For i = 0 To .Rows - 1
             .RowHeight(i) = Me.ScaleHeight / .Rows
         Next
    End With
End Sub

Private Sub fg_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With fg
         .Col = .MouseCol
         .Row = .MouseRow
    End With
    ShowSeatStatus
End Sub

Private Sub fg_DblClick()
    With fg
         If .Row = 0 Or .Col = 0 Or .CellBackColor = vbGreen Then Exit Sub
         If .CellBackColor = vbRed Then
            'make seat available again (maybe ask for confirmation ?)
            .CellBackColor = vbWhite
         Else
            'make seat reserved (maybe ask for confirmation ?)
            .CellBackColor = vbRed
          End If
    End With
    ShowSeatStatus
End Sub

Private Sub ShowSeatStatus()
    Dim TheCaption As String
    With fg
         Select Case .CellBackColor
                Case vbGreen
                     .MousePointer = flexNoDrop
                     TheCaption = "Pathway"
                Case Else
                     .MousePointer = flexDefault
                     If .Row = 0 Or .Col = 0 Then
                         TheCaption = "Header"
                     Else
                         TheCaption = "Seat " & .TextMatrix(.Row, 0) & "-" & .TextMatrix(0, .Col)
                         If .CellBackColor = vbRed Then
                            TheCaption = TheCaption & " Reserved"
                         Else
                            TheCaption = TheCaption & " Free"
                        End If
                     End If
         End Select
    End With
    Me.Caption = TheCaption
End Sub

not extensively tested and no attempt made to link to a database
in fact, i do not clearly 'see' the database

Hi

hope you don' mind, I added a few things.
Function=SaveToFile and ReadFromFile
when you doubleclick a cell it will add a simple "x"

just about ready to sell ticket's ;-)))

Private Sub Command1_Click()
Call SaveToFile("C:\ChristFlex.txt", fg, , ";")
End Sub

Private Sub Command2_Click()
Call ReadFromFile("C:\ChristFlex.txt", fg, , ";")
End Sub


Private Sub Form_Load()
Dim i As Integer
    With fg
         .ScrollBars = flexScrollBarNone
         .FocusRect = flexFocusHeavy
         .Appearance = flexFlat
         .AllowBigSelection = False
         .Cols = 33 '28 seat columns + 1 row header + 4 pathways
         .Rows = 20 '17 seat rows + 1 column header + 2 pathways
         .Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
         .ColAlignment(-1) = flexAlignCenterCenter
           
         'the column header (3 seat blocks)
         For i = 2 To 10
             .TextMatrix(0, i) = i - 1
         Next
         For i = 12 To 21
             .TextMatrix(0, i) = i - 2
         Next
         For i = 23 To 31
             .TextMatrix(0, i) = i - 3
         Next

        'the row header
         For i = 2 To 18
             .TextMatrix(i, 0) = Chr(64 + i - 1)
         Next
    
        'the 6 pathways
        .FillStyle = flexFillRepeat
        .Row = 1
        .Col = 1
        .ColSel = .Cols - 1
        .CellBackColor = vbGreen
        
        .Row = .Rows - 1
        .Col = 1
        .ColSel = .Cols - 1
        .CellBackColor = vbGreen
            
        .Col = 1
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
        
        .Col = 11
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
    
        .Col = 22
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
        
        .Col = 32
        .Row = 1
        .RowSel = .Rows - 1
        .CellBackColor = vbGreen
    End With
End Sub

Private Sub Form_Resize()
    With fg
         .Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
         For i = 0 To .Cols - 1
             .ColWidth(i) = Me.ScaleWidth / .Cols
         Next
         For i = 0 To .Rows - 1
             .RowHeight(i) = Me.ScaleHeight / .Rows
         Next
    End With
End Sub

Private Sub fg_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    With fg
         .Col = .MouseCol
         .Row = .MouseRow
    End With
    ShowSeatStatus
End Sub

Private Sub fg_DblClick()
    With fg
         If .Row = 0 Or .Col = 0 Or .CellBackColor = vbGreen Then Exit Sub
         If .CellBackColor = vbRed Then
            'make seat available again (maybe ask for confirmation ?)
            .CellBackColor = vbWhite
         Else
            'make seat reserved (maybe ask for confirmation ?)
            .CellBackColor = vbRed
            
            'Edit Chris : just added a X
            .Text = "x"
          
          End If
    End With
    ShowSeatStatus
End Sub

Private Sub ShowSeatStatus()
    Dim TheCaption As String
    With fg
         Select Case .CellBackColor
                Case vbGreen
                     .MousePointer = flexNoDrop
                     TheCaption = "Pathway"
                Case Else
                     .MousePointer = flexDefault
                     If .Row = 0 Or .Col = 0 Then
                         TheCaption = "Header"
                     Else
                         TheCaption = "Seat " & .TextMatrix(.Row, 0) & "-" & .TextMatrix(0, .Col)
                         If .CellBackColor = vbRed Then
                            TheCaption = TheCaption & " Reserved"
                         Else
                            TheCaption = TheCaption & " Free"
                        End If
                     End If
         End Select
    End With
    Me.Caption = TheCaption
End Sub

'Flexgrid in eine Datei schreiben
Public Function SaveToFile(FileName As String, _
                           mFlex As MSFlexGrid, _
                           Optional RowDelimiter As String = vbCrLf, _
                           Optional ColDelimiter As String = vbTab) As Boolean

   Dim Rows() As String, Cols() As String
   Dim i As Long, j As Long
   Dim FNr As Integer
   
      On Error GoTo Fehler
      ReDim Rows(mFlex.Rows - 1)
      'ein Array füllen
      For i = 0 To UBound(Rows)
         'Spaltenwerte übernehmen
         ReDim Cols(mFlex.Cols - 1)
         For j = 0 To UBound(Cols)
            Cols(j) = mFlex.TextMatrix(i, j)
            'ggf Delimiter entfernen
            Cols(j) = Replace(Cols(j), ColDelimiter, Space(1))
            'CrLf ersetzen
            Cols(j) = Replace(Cols(j), vbCrLf, vbCr)
         Next
         'als Zeile übernehmen
         Rows(i) = Join(Cols, ColDelimiter)
         'ggf Delimiter entfernen
         Rows(i) = Replace(Rows(i), RowDelimiter, Space(1))
      Next
      FNr = FreeFile
      Open FileName For Output As #FNr
      Print #FNr, Join(Rows, vbCrLf);
      Close #FNr
      
      SaveToFile = True
      On Error GoTo 0
      Exit Function
Fehler:
      FehlerAnzeige Err.Number, Err.Description, "SaveToFile"
      On Error GoTo 0
End Function
'Flexgrid aus einer Datei füllen
Public Function ReadFromFile(FileName As String, _
                            mFlex As MSFlexGrid, _
                            Optional RowDelimiter As String = vbCrLf, _
                            Optional ColDelimiter As String = vbTab) As Boolean

   Dim Rows() As String, Cols() As String, s As String
   Dim i As Long, j As Long
   Dim FNr As Integer
      If Len(Dir(FileName)) = 0 Then
         MsgBox "Datei nicht gefunden", vbInformation, "ReadFromFile"
         Exit Function
      End If
      On Error GoTo Fehler
      'Datei binär komplett einlesen
      FNr = FreeFile
      Open FileName For Binary As #FNr
      s = Space(LOF(FNr))
      Get #FNr, , s
      Close #FNr
      'Datei prüfen
      If Len(s) = 0 Then
         s = Space(1)
      End If
      'in Zeilen zerlegen
      Rows() = Split(s, RowDelimiter)
      '1. Zeile splitten
      Cols() = Split(Rows(1), ColDelimiter)
      'Flexgrid herrichten
      i = mFlex.Rows + 1
      If i < mFlex.FixedRows + 1 Then
         i = mFlex.FixedRows + 1
      End If
      With mFlex
         .Redraw = True
         'verkleinern
         .Rows = i
         'Restinhalte löschen
         .Clear
         'dimensionieren
         i = UBound(Rows) + 1
         If i > .Rows Then
            .Rows = i
         End If
         j = UBound(Cols) + 1
         If j > .Cols Then
            .Cols = j
         End If
         'Flexgrid füllen
         For i = LBound(Rows) To UBound(Rows)
            'Zeile für Zeile
            Cols() = Split(Rows(i), ColDelimiter)
            For j = LBound(Cols) To UBound(Cols)
               'ersetze Cr durch CrLf
               .TextMatrix(i, j) = Replace(Cols(j), vbCr, vbCrLf)
            Next
         Next
         .Row = .FixedRows
         .Col = .FixedCols
         .Redraw = True
      End With
      ReadFromFile = True
      On Error GoTo 0
      Exit Function
Fehler:
      FehlerAnzeige Err.Number, Err.Description, "ReadFromFile"
      On Error GoTo 0
End Function


Public Sub FehlerAnzeige(ErrNumber As Long, ErrDescription As String, _
                         Optional Titel As String = "")

   Dim Msg As String
      Msg = "Fehler " & ErrNumber & vbCrLf & vbCrLf & _
            ErrDescription
      If Len(Titel) > 0 Then
         MsgBox Msg, vbCritical, Titel
      Else
         MsgBox Msg, vbCritical
      End If
End Sub

regards
Chris

[IkkeEnGij]

Hi
hope you don' mind, I added a few things.

you'r welcome

[joshidharmesh101]

Hello friends,

My project is moving fast. I am thankful to all who have posted useful suggestions & guided me.

In the ticket booking page I need to filter data from access table named Movie_Time. I want to filter unique records which have Mov_Name (Data Field) equal to cboMovie.Text and txtDate.Value (Date Picker Value) between Week_StDate (Data Field) and Week_EnDate (Data Field)

I am running following code.

Private Sub cboMovie_LostFocus()
Dim Mov As New ADODB.Recordset
Set Mov = New ADODB.Recordset
Mov.Open "select * from Movie_Time where Mov_Name = " & cboMovie.Text & " and #" & Format(txtDate.Value, "MM/DD/YY") & "# between Week_StDate and Week_EnDate ", CN, adOpenDynamic, adLockPessimistic
Mov.MoveFirst
While Mov.EOF = False
    cboTime.AddItem (Mov.Fields("Mov_Time"))
    Mov.MoveNext
Wend
Mov.MoveFirst
cboScreen.AddItem (Mov.Fields("Screen"))
cboScreen.Text = Mov.Fields("Screen")
Mov.Close

End Sub

I am getting following error message



Help me.

Thanks,

Dharmesh Joshi

[ChrisE]

Hi,

it is probably the Date(s)

here a sample how to pass Dates with Between

Dim d As Date, d1 As Date
   Dim s As String, s1 As String
   Dim sSQL As String
   
      d = CDate("01.09.2017")
      d1 = CDate("11.09.2017")
      
      s = Format(d, "\#mm\/dd\/yyyy\#")
      s1 = Format(d1, "\#mm\/dd\/yyyy\#")
      
      sSQL = "Select * From Table1 Where myDate Between " & s & " And " & s1 & ";"
      Debug.Print sSQL

Edit:
I just see you are using the Data Picker
change to this

 s = Format(DTPicker1.Value, "\#mm\/dd\/yyyy\#")
      s1 = Format(DTPicker2.Value, "\#mm\/dd\/yyyy\#")

regards
Chris

[techgnome]

I'm going to go with the Movie Name:

 "select * from Movie_Time where Mov_Name = " & cboMovie.Text & " and #" & Format(txtDate.Value, "MM/DD/YY") & "# between Week_StDate and Week_EnDate ", CN, adOpenDynamic, adLockPessimistic

You can't just throw text in the middle of a SQL statement... let's say you're looking for a movie called The Young Ones....
your SQL would look like this:

select * from Movie_Time where Mov_Name = The Young Ones and #09/11/2017# between Week_StDate and Week_EnDate

Problem is that it would see "the" as a field name and Young Ones as a possible parameter, or at least as something it doesn't recognize.
Just like the Dates you need to mark it as text with single quote marks:

 "select * from Movie_Time where Mov_Name = '" & cboMovie.Text & "' and #" & Format(txtDate.Value, "MM/DD/YY") & "# between Week_StDate and Week_EnDate ", CN, adOpenDynamic, adLockPessimistic

select * from Movie_Time where Mov_Name = 'The Young Ones' and #09/11/2017# between Week_StDate and Week_EnDate

Even better would be to use parameters but I'm too tired at the moment and I haven't had my coffee yet.

-tg

[ChrisE]

Hi tg

had a good laugh

Even better would be to use parameters but I'm too tired at the moment and I haven't had my coffee yet.

-tg

what Time is it ? in Germany it's just about 3 in the afternoon

regards
Chris

[techgnome]

It was about 8:30 am when I wrote that... I'm not a morning person... we've got a new puppy, and dealing with what's left of hurricane Irma (which really isn't much). Kids were asleep in the living room, so I was trying to be quiet which meant not making noise in the kitchen. If I had my druthers, I'd go back to bed. Office is closed, but since we're able to work from home... as long as there's power... well... we're expected to bill.... sigh...

-tg

[ChrisE]

It was about 8:30 am when I wrote that... I'm not a morning person... we've got a new puppy, and dealing with what's left of hurricane Irma (which really isn't much). Kids were asleep in the living room, so I was trying to be quiet which meant not making noise in the kitchen. If I had my druthers, I'd go back to bed. Office is closed, but since we're able to work from home... as long as there's power... well... we're expected to bill.... sigh...

-tg

hope Irma didn't cause to much damage and everbody is well. I lived as a child 4-5 Year's in Hutchinson Kansas and I can
remember the Tornados well. They can be devastating.

regards
Chris

[techgnome]

hope Irma didn't cause to much damage and everbody is well. I lived as a child 4-5 Year's in Hutchinson Kansas and I can
remember the Tornados well. They can be devastating.

regards
Chris

I'm in Charleston, SC... originally we were supposed to be hit head-on... fortunately for us, it delayed that turn to to the north and hit Florida instead. we had three evacuation plans depending on how bad things got. Instead we're riding it out. Luckily we're high enough elevation flooding shouldn't be an issue. We survived the 1,000 year flood two years ago and Mathew last year, so we'll be OK after Irma too. I'm hoping the power goes out. I just want an excuse to use my new generator.
Prior to this, I lived 13 years just outside Omaha, Nebraska... I've seen the tornadoes first hand. After experiencing those and hurricanes... I can without doubt say I'm not emotionally or mentally capable of handling them well. I'd rather deal with the earthquakes I grew up with. At least when they happen, they are over and done in matter of seconds, often before you realize what's happening. And if your house does fall, your stuff is still there in a pile, not strewn into the next county.

-tg

[ChrisE]

I've seen the tornadoes first hand. After experiencing those and hurricanes... I can without doubt say I'm not emotionally or mentally capable of handling them well

yes, same here.

they neighbours thought it was funny(crazy German the said) that my Dad(typical German) built a stone House, within the basement was a stormshelter with TV,fridge etc... for 5-8 people.
Well it was always full of neighbours when a BIG Tornado was coming.

[IkkeEnGij]

back on topic:
probably it is just me, but:
i simply can not see what the code put here by joshidharmesh101
has to do with reserving (or selling), a specific seat for a specific screen for a specific timeperiod

the best i can make of it, is an attempt to assign a specific movie to a specific screen for a specific timeperiod
and even so i am rather confused by some fields such as:
Fields("Cls") ? , a field to clear the screen ?
Fields("Price") , is the price dependent on the movie ? or the screen ? or the combination movie_screen ? or the combination movie_screen_time ? or what ?
Fields("Week_StDate") ?
Fields("Week_EnDate") ?
is the combination movie_screen always fixed for an entire week ?

@joshidharmesh101 , maybe put your database here (could maybe make things a bit clearer)