PDA

View Full Version : Solved: module Excel VBA for manage parking places



noxios
03-21-2013, 07:10 AM
Hello
I have a small problem, for which I ask you some help: :help
I have been developing a program in Excel VBA for manage a given number of parking places (10).
The program is operational but need a module to inform me (or the user) the availability of parking places for each day (the next day it should reinitiate the countdown). Please note the allocation of parking places is done daily.
I was thinking a pop up window that open whenever I click to enter new parking reserve and let me see the remain parking places for a day in particular (not the day of today because the reservation can be made long before the real need).

Kind regards :bow:

noxios
03-27-2013, 01:25 AM
:think:
Well…, I think my prior post it’s not so clear therefore I did a more detailed version of my initial request for help.
-----------------------------------------------------------------------

I have a worksheet (Parking) which contains dates in (column B) and parking places in (column D).
What I want to do is search (column B) for each instance of a specifyed date (entered in a TextBox from a Userform) and when the specific date is found go to (column D) and find the matching Parking place of the same ROW.
I then need to copy/show the all Parking places already reserved for that specific date from the worksheet to a Userform (ListBox).


The overall idea is to see which parking places/spots are already reserved and the ones that are possible to pick for next reservation.

Thanks for any assistance given to this problem.

mdmackillop
03-27-2013, 05:36 PM
A different layout to simplify coding

noxios
03-28-2013, 01:52 AM
A different layout to simplify coding

First of all, thank you for your interest in order to help me.
I will test/try this possibility and come back with the results.

Thank you.

noxios
07-04-2013, 09:06 AM
A different layout to simplify coding


mdmackillop
Sorry for the lack of response all this time, but was out of the country, however I could not understand the logic and even adapt it to the existing program.

I Send a code obtained on the net (with explanations of each line) which I think will be the most direct approach to my case, however it doesn’t do comparisons as described in the initial message.

It would be possible for you to adapt it to my need as described?


Option Explicit

Private Sub UserForm_Initialize()
Dim rngLastCell As Range
Dim aryValues As Variant
Dim DIC As Object
Dim n As Long

'using the sheet's codename."
With Workbooks("Cadastro_Dados.xls").Worksheets("Parking")

'Ensure that data exists, setting a reference to the last cell with
'anything in it, in A2 and thereafter in the column.
Set rngLastCell = RangeFound(.Range(.Cells(2, "A"), .Cells(.Rows.Count, "A")))

'In case no data exists, leave a way to skip out.
If Not rngLastCell Is Nothing Then

'Data exists? Then create and reference a DIctionary Object.
Set DIC = CreateObject("Scripting.Dictionary")

'Grab the values from the range and plunk into an array.
aryValues = .Range(.Range("D2"), .Range("D65536").End(xlUp))
' aryValues = .Range(.Cells(2, "B"), rngLastCell).Value)

'Run through the values. Using the dictionary's keys, we either
'add a new key (for a new value), or just overwrite the already
'created key's (if the key already exists) value in .Item, which
'inour case, is left empty, as we are just using the .Key to create a unique list.
For n = LBound(aryValues, 1) To UBound(aryValues, 1)
DIC.Item(aryValues(n, 1)) = Empty
Next

'.Keys is a 1-dimensional array, so Transpose to chunk into .List
Me.ListBox1.List = Application.Transpose(DIC.Keys)
End If
End With
End Sub



Some extra details:
I use office 2010 with a userform to get dates

lotuxel
07-05-2013, 12:39 AM
Private Sub UserForm_Initialize()
Dim rngl As Range
Dim r As Range

Dim target_date As Date

Dim n As Long

target_date = Me.ListBox1.Value

'using the sheet's codename."
With Workbooks("Cadastro_Dados.xls").Worksheets("Parking")

'Ensure that data exists, setting a reference to the last cell with
'anything in it, in A2 and thereafter in the column.
Set Rng = .Range("a2:a" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each r In Rng
If r = target_date Then
For n = 2 To [b1].End(xlToRight).Column
If Cells(r.Row, n).Value = "X" Then
With Me.listbox2
.AddItem Cells(r.Row, n).Value
End With
End If
Next n
Exit For
End If
Next r
End With
End Sub

Liam78
07-05-2013, 03:35 AM
thank you soo much, this is most useful for me and my work

noxios
07-08-2013, 12:51 AM
lotuxel

Thank you for your help in trying to solve this problem.
However after trying to introduce the code I get an error in return:

Run-time error '94':
Invalid use of Null

Please explain more concretely what is the value of "X" in the posted code.
If Cells (r.Row, n). Value =" X "Then"


Private Sub UserForm_Initialize()
Dim rngl As Range
Dim r As Range

Dim target_date As Date

Dim n As Long

target_date = Me.ListBox1.Value

'using the sheet's codename."
With Workbooks("Cadastro_Dados.xls").Worksheets("Parking")

'Ensure that data exists, setting a reference to the last cell with
'anything in it, in A2 and thereafter in the column.
Set Rng = .Range("a2:a" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each r In Rng
If r = target_date Then
For n = 2 To [b1].End(xlToRight).Column
If Cells(r.Row, n).Value = "X" Then
With Me.listbox2
.AddItem Cells(r.Row, n).Value
End With
End If
Next n
Exit For
End If
Next r
End With
End Sub

lotuxel
07-08-2013, 01:26 AM
The "X" is occupied car park!
May be you change like that


Private Sub UserForm_Initialize()
Dim rngl As Range
Dim r As Range

Dim target_date As Date

Dim n As Long

target_date = Me.ListBox1.Value

'using the sheet's codename."
With Workbooks("Cadastro_Dados.xls").Worksheets("Parking")

'Ensure that data exists, setting a reference to the last cell with
'anything in it, in A2 and thereafter in the column.
Set Rng = .Range("a2:a" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each r In Rng
If r = target_date Then
Me.listbox2.clear
For n = 2 To [b1].End(xlToRight).Column
If ucase(Cells(r.Row, n).Value) = "X" Then
With Me.listbox2
.AddItem Cells(r.Row, n).Value
End With
End If
Next n
Exit For
End If
Next r
End With
End Sub

lotuxel
07-08-2013, 01:28 AM
Sorry forgot to change this ...

With Me.listbox2
.AddItem "Car Park # : " & Cells(1, n).Value
End With

noxios
07-08-2013, 01:50 AM
Oh ok,
Actually i don't use any "X" for used or something like that instead I use the real imatriculação number of the vehicle as well as names and dates, never "X's"

Thanks I will try this last option as referred.


Sorry forgot to change this ...


Private Sub UserForm_Initialize()
Dim rngl As Range
Dim r As Range

Dim target_date As Date

Dim n As Long

target_date = Me.ListBox1.Value

'using the sheet's codename."
With Workbooks("Cadastro_Dados.xls").Worksheets("Parking")

'Ensure that data exists, setting a reference to the last cell with
'anything in it, in A2 and thereafter in the column.
Set Rng = .Range("a2:a" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each r In Rng
If r = target_date Then
Me.listbox2.clear
For n = 2 To [b1].End(xlToRight).Column
If ucase(Cells(r.Row, n).Value) = "X" Then
With Me.listbox2
.AddItem "Car Park # : " & Cells(1, n).Value
End With
End If
Next n
Exit For
End If
Next r
End With
End Sub

noxios
07-08-2013, 02:47 AM
For a better understanding of the project I attach a "model" compact.
As you can see I work in two different workbooks (as well with several sheets within the workbooks) one workbook is the database and the other is for the program itself (the VBA code resides in this one).

The small program that I need must check the parking places already entered (in the database workbook called "Cadastro_Dados.xls" ("Parking" worksheet)) and only make visible those who are still possible to assign/reserve for the day intended (specified in the date "textbox")
NOTE: the entering of date can be done by clicking 2 times in the Date "textbox" in this case the calendar will pop-up or just by entering the date manually.