Enter date and Number to find the result

[Pinkster69]

Hi Guys,
Just new to VBA, so I hope you can help me on a problem I am having!

I created a spreadsheet that I use for Hat Hire where I indicate on the intersection between the Date and the Hat SKU Number what Days the Hat is out on Hire with the number "1". I have Dates listed on the first row and I have the Hat SKU numbers on the first Column. I have attached a sample Spreadsheet to give you a better Idea of what I am talking about.

Firstly I am looking for help with code whereby if I enter a Date "Textbox1" eg: 02/06/2012 and a Hat SKU Number "Textbox 2" eg: SKU101 on a userform it will enter the number "1" in the intersecting cell as shown below.

Secondly if I enter a Date "Textbox1" and a Hat SKU Number "Textbox 2" on a different userform then if it finds the number "1" it will display "Hired" in "Textbox 3" and if it find the cell blank it displays "Available" in Textbox 3.

Hope you can help guys?

Hat	01/06/2012	02/06/2012	03/06/2012	04/06/2012
SKU100
SKU101		1
SKU102
SKU103

<tbody>
</tbody>

 

[tlowry]

Here is my take on what you asked for (put it in the forms' module):

'--------------------------------------------------------
'--------------------------------------------------------
Const DataSheet = "Data"        ' Sheet with data
Const HatDates = "B17:E17"      ' Address of dates
Const HatSKUs = "A18:A21"       ' Address of SKUs
Const FLAGGEDTEXT = "Hired"     ' Text to display
Const FLAG = 1                  ' flag
'--------------------------------------------------------
'--------------------------------------------------------
Private Sub SetFlag()    ' Set flag in table
    On Local Error GoTo errors
    With Sheets(DataSheet)
        Set DateFound = .Range(HatDates).Find(what:=TextBox1.Value)
        Set SKUFound = .Range(HatSKUs).Find(what:=TextBox2.Value)
        .Cells(SKUFound.Row, DateFound.Column) = FLAG
    End With
    Exit Sub
errors:
    MsgBox "Error: " & Err.Description
End Sub
'--------------------------------------------------------
'--------------------------------------------------------
Private Sub GetFlag()      ' display "Hired" if flagged
    On Local Error GoTo errors
    With Sheets(DataSheet)
        Me.TextBox3 = ""
        Set DateFound = .Range(HatDates).Find(what:=TextBox1.Value)
        Set SKUFound = .Range(HatSKUs).Find(what:=TextBox2.Value)
        If .Cells(SKUFound.Row, DateFound.Column) = FLAG Then Me.TextBox3 = FLAGGEDTEXT
    End With
    Exit Sub
errors:
    MsgBox "Error: " & Err.Description
End Sub
'--------------------------------------------------------
'--------------------------------------------------------

However, rather than TextBoxes for data entry, I suggest ListBoxes/ComboBoxes which would limit the user to the data which is valid. Also, why not have just one form?

 

[Pinkster69]

Hi tLowry,

Thanks so much for that!
I created a userform with Textbox1,2,3, names the worksheet "Data" and inserted the code into the forms module but unfortunitly it didn't work?
I must be doing something wrong or forgotten something!

How would you suggest i initiate the code to work

Derek

 

[tlowry]

Did anything happen when it didn't work?

Did you set all the const to your values?

Const DataSheet = "Data"        ' Sheet with data
Const HatDates = "[B]B17:E17"  [/B]    ' Address of dates
Const HatSKUs = [B]"A18:A21"[/B]       ' Address of SKUs
Const FLAGGEDTEXT = "Hired"     ' Text to display
Const FLAG = 1                  ' flag

 

[tlowry]

To initiate the code, I put two CommandButtons on the form

One called "SetHiredFlag" with code:

Private Sub SetHiredFlag_Click()
    SetFlag
End Sub

The other called "HiredCheck" with code:

Private Sub HiredCheck_Click()
    GetFlag
End Sub

 

[Pinkster69]

Hi tLowry,

Did what you suggested, An error comes up when I press either Command Button

"Error: Object Variable or With Block Variable not set"


Rechecked all my values..

Sheet Name is "Data"
My HatDates are in Cells B17 to E17 - 01/06/12, 02/06/2012 etc
My HatSKUs are in Cells A18 to A21 - SKU100, SKU101 etc
Made sure Textbox1 relates to Date entries
Made sure Textbox2 relates to SKU entries
Made sure Textbox3 is blank for result when I press CommandButtons
CommandButtons are set as requested.

The Dates that I have in Cells B17 to E17 I formatted them to "Dates" on the Format Cells dialog box on the Excel sheet it self. Would this be correct or should I have left them to General Format? I switched it back to General Format and still came up with the Error!! No joy there.

Did you do a test on the code yourself with a userform and did it work for you?

regards

Derek

 

[tlowry]

Are the ranges with data in sheet "Data"?

Can you post all the code in the form?

I have two listboxes ""LBSKUs" and "LBDates" on the form

Here is all my code...

'--------------------------------------------------------
'--------------------------------------------------------
Const DataSheet = "Data"        ' Sheet with data
Const HatDates = "B17:E17"      ' Address of dates
Const HatSKUs = "A18:A21"       ' Address of SKUs
Const FLAGGEDTEXT = "Hired"     ' Text to display
Const FLAG = 1                  ' flag
'--------------------------------------------------------
'--------------------------------------------------------
Private Sub SetFlag()    ' Set flag in table
    On Local Error GoTo errors
    With Sheets(DataSheet)
        Set DateFound = .Range(HatDates).Find(what:=TextBox1.Value)
        Set SKUFound = .Range(HatSKUs).Find(what:=TextBox2.Value)
        .Cells(SKUFound.Row, DateFound.Column) = FLAG
    End With
    Exit Sub
errors:
    MsgBox "Error: " & Err.Description
End Sub
'--------------------------------------------------------
'--------------------------------------------------------
Private Sub GetFlag()      ' display "Hired" if flagged
    On Local Error GoTo errors
    With Sheets(DataSheet)
        Me.TextBox3 = ""
        Set DateFound = .Range(HatDates).Find(what:=TextBox1.Value)
        Set SKUFound = .Range(HatSKUs).Find(what:=TextBox2.Value)
        If .Cells(SKUFound.Row, DateFound.Column) = FLAG Then Me.TextBox3 = FLAGGEDTEXT
    End With
    Exit Sub
errors:
    MsgBox "Error: " & Err.Description
End Sub
'--------------------------------------------------------
'--------------------------------------------------------
Private Sub HiredCheck_Click()
    GetFlag
End Sub
Private Sub LBDates_Click()
    Me.TextBox1 = Me.LBDates.Value
End Sub

Private Sub LBSKUs_Click()
    Me.TextBox2 = Me.LBSKUs.Value
End Sub
Private Sub SetHiredFlag_Click()
    SetFlag
End Sub
Private Sub UserForm_Initialize()
    Me.LBDates.Clear
    Me.LBSKUs.Clear
    For Each cCell In Range("HatDates").Cells
        Me.LBDates.AddItem cCell
    Next cCell
    For Each cCell In Range("HatSKUs").Cells
        Me.LBSKUs.AddItem cCell
    Next cCell
End Sub

 

[Pinkster69]

That worked a charm, Thank you!
One last question if I may ask! Is it possible to check if the Hat is out for a 5 day period using the same Textbox or using multiple Textboxes representing the 5 Day Hire Period? If the code finds that at least 1 or more days from the initial Date entry has the Flag 1 in one of the cells the Textbox or Textboxes will indicate "Hired"


Regards

Derek

 

[tlowry]

You should post this as a new thread.

 

[Pinkster69]

Will do! Thanks again for all your help!