Find multiple Dates & a Number and pass result to Textbox as true/False

[Pinkster69]

Hi Guys,

I am looking for VBA code to search for multiple entries and if those multiple entries are "True" then the code will pass the Answer in a Textbox as "Hired" or "Available"
Basically I am trying to develop a little program for Hat Hire whereby if I enter the Date of when the customer wants to hire a Hat and the SKU Number of the Hat itself the code will check to see if the hat is available on that date by passing the number "1" as true or false etc and display in a Textbox as "Hired" or "Available".
I found success in doing this but i was wondering is it possible to code whereby we can check the following 4 days from the Date entered when the customer wants to hire the hat and if those days have not got the number "1" in the cells for those 5 days then the Textbox would display "Available" otherwise "Hired" etc.

I have attached a sample code etc to give you a better idea of what I have done so far. On the Form itself when you Press the HiredCheck Command Button you are checking to see if the Hat is Hired or not Hired, When you Press the SetHiredFlag Command Button you are entering a number "1" in the relevant cell corresponding to the Date & SKU Number

Hope you can help

'--------------------------------------------------------'--------------------------------------------------------
Const DataSheet = "Data"        ' Sheet with data
Const HatDates = "B17:I17"      ' 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

 

[AlphaFrog]

I'm not sure I follow, but try something like this...

In the GetFlag procedure, replace this line...
If .Cells(SKUFound.Row, DateFound.Column) = FLAG Then Me.TextBox3 = FLAGGEDTEXT

With this...
If WorksheetFunction.CountIf(.Cells(SKUFound.Row, DateFound.Column).Resize(, 5), FLAG) > 0 Then Me.TextBox3 = FLAGGEDTEXT


It resizes the test cell .Cells(SKUFound.Row, DateFound.Column) to to five columns wide .Resize(, 5) and then counts if any of those five cells contain a 1 or FLAG

 

[Pinkster69]

Hi AlphaFrog,

Thanks so much for getting back to me! It worked like a charm! Been racking my brain for day's trying to figure it out.

Cheers mate!