Simple 'Dispensing' program

[peteprp]

Hi all,
I want to create a very simple dispensing program. I have an excel listing of medications - see below. I want to be able to do a 'wildcard' search for a particular medication and then be able to enter the quantity dispensed. The quantity dispensed should be added to the cumulative total dispensed for that particular medication. At the end of the day or week, I'd like to be able to see & download/copy the total amount dispensed for each medication.

DRUG NAME	UNITS
Aluminium Chlorohydrate Cream 20%	Ea
Aluminium sulphate Solution 20% Spray 25mL	Ea
Amethocaine Mimum 0.5% 20's	Per Minum
Aminophylline Amps 250mg/10ml	Per Amp
Amiodarone Inj 150mg/3mL	Per Amp
Amlodipine Tabs 10mg	Per Tab
Amoxycillin 100mg Drps	Ea
Amoxycillin 400mg, clavulanate 57mg Syr	Ea
Amoxycillin 875mg, clavulanate 125mg Tabs	Per Tab
Amoxycillin Amps 1gm	Per Vial
Amoxycillin Caps 250mg	Per Caps
Amoxycillin Caps 500mg	Per Caps
Amoxycillin Syrup SF 125mg/5ml	Ea
Amoxycillin Syrup SF 250mg/5ml	Ea
Antazoline/ Naphazoline Eye Drops	Ea
Aqueous Cream 100g cream	Ea
Artesunate Inj 60mg	Per Vial

<tbody>
</tbody>

Search Drug Name:

For example, type in amox 25 c

<tbody>
</tbody>

Then show result below together with Units column & add
the number of capsules dispensed in the column alongside
		Enter Number Dispensed
Amoxycillin Caps 250mg	Per Caps	5​

<tbody>
</tbody>

If anyone can help, I would really appreciate it. Is it possible to do this without using a macro?
Thank you.
Pete

 

[peteprp]

Hi Peter. Thanks again for all your help on this. I have taken the plunge & bought a PC. It works fine on the PC, well, almost fine - enter ring 'amox c' comes up with a few other options.

DRUG NAME	UNITS	No Dispensed	Search components - >	amox c
Amoxycillin 100mg Drps	Ea
Amoxycillin 400mg, clavulanate 57mg Syr	Ea
Amoxycillin 875mg, clavulanate 125mg Tabs	Per Tab
Amoxycillin Amps 1gm	Per Vial
Amoxycillin Caps 250mg	Per Caps
Amoxycillin Caps 500mg	Per Caps
Amoxycillin Syrup SF 125mg/5ml	Ea
Amoxycillin Syrup SF 250mg/5ml	Ea

<colgroup><col><col><col><col><col></colgroup><tbody>
</tbody>

Is that easy to fix?
Cheers
Pete

 

[Peter_SSs]

I have taken the plunge & bought a PC.

Wow, that is a plunge indeed.

It works fine on the PC, well, almost fine - enter ring 'amox c' comes up with a few other options.

That seems to be working perfectly correctly as I see it and as you agreed in post #3 .
All those values you have given here contain both strings
Amoxycillin

 

[peteprp]

I thought maybe the space might be used to reference a different word in the Drug Name field. Am I being too difficult here?

 

[Peter_SSs]

Deleted. Sorry, incorrect answer. I'll have to re-think it.

 

[Peter_SSs]

Try this version

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rSch As Range
  Dim s As String, sTest1 As String, sTest2 As String, FilterVals As String
  Dim aFltrVals As Variant, aNames As Variant, itm As Variant, FltrCrit As Variant
  Dim RX As Object, M As Object
  Dim i As Long, NumStrings As Long
  
  Set rSch = Range("SearchText")
  If Not Intersect(Target, rSch) Is Nothing Then
    Application.ScreenUpdating = False
    s = Application.Trim(rSch.Value)
    If ActiveSheet.FilterMode Then ShowAllData
    If Len(s) > 0 Then
      With Range("A1").CurrentRegion.Resize(, 3)
        NumStrings = UBound(Split(s)) + 1
        Set RX = CreateObject("VBScript.RegExp")
        RX.Global = True
        RX.IgnoreCase = True
        RX.Pattern = "(\b[^ ]*?)(" & Replace(s, " ", "|") & ")(?=[^ ]* )"
        sTest1 = "|" & Replace(s, " ", "||") & "|"
        aNames = .Columns(1).Value
        For i = 2 To UBound(aNames)
          Set M = RX.Execute(Replace(aNames(i, 1), Chr(160), " ") & " ")
          If M.Count >= NumStrings Then
            sTest2 = sTest1
            For Each itm In M
             sTest2 = Replace(sTest2, "|" & itm.submatches(1) & "|", "", 1, -1, 1)
            Next itm
            If sTest2 = vbNullString Then FilterVals = FilterVals & "|" & aNames(i, 1)
          End If
        Next i
        If Len(FilterVals) = 0 Then
          FltrCrit = "@@@"
        Else
          FltrCrit = Split(Mid(FilterVals, 2), "|")
        End If
          .AutoFilter Field:=1, Criteria1:=FltrCrit, Operator:=xlFilterValues
      End With
    End If
    Application.ScreenUpdating = True
  End If
End Sub

 

[peteprp]

Perfect!! Thank you very much. Is it now possible to have a look at a method of recording quantities dispensed? If you have the time of course. I hope I'm not being too much of a nuisance.

 

[Peter_SSs]

Perfect!! Thank you very much.

Great news.

Is it now possible to have a look at a method of recording quantities dispensed?

I don't know what you envisage. I'm guessing that you type some text into our 'search box' and the data gets filtered to show, say, 3 rows. What happens next, where & how?

 

[peteprp]

I was thinking of deleting the 'Search Components' column. Then type in the numerical quantity of the chosen medication in the 'Number Dispensed' column. That would 'add' the quantity dispensed to (possibly) previous amounts dispensed in a hidden column labelled 'Totals Dispensed' which is part of the stock file. Does that make sense?
The dispensed quantity screen may now look as follows:

DRUG NAME	UNITS	No Dispensed	amox 5 c
Amoxycillin 400mg, clavulanate 57mg Syr	Ea
Amoxycillin 875mg, clavulanate 125mg Tabs	Per Tab
Amoxycillin Caps 250mg	Per Caps	10
Amoxycillin Caps 500mg	Per Caps

<colgroup><col><col span="3"></colgroup><tbody>
</tbody>

Hope I've made sense here. Thanks again.

 

[Peter_SSs]

That could happen immediately that you typed the number into the 'No. Dispensed' column but I would not recommend that. You would only have to accidentally type a wrong digit or press Enter before you meant to and the incorrect number would be added in to the hidden column. Instead, my suggestion involves typing the No. Dispensed in and then double-clicking that value when you are confident that it is correct and you want it added to the Totals Dispensed cell.

So, the code suggested below does what I have described after you enter a value in No. Dispensed & then double-click that number. In addition It clears the value that you just double-clicked and (I'm not certain you want this) it then clears the 'SearchText' cell so that all data is again displayed, ready for the next search.

This code goes in the same module as the previous Worksheet_Change code (either above or below that code)

I've assumed that column D is the hidden 'Totals Dispensed' column. Change that in the code if required.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Target.Column = 3 Then
    If IsNumeric(Target.Value) Then
      Cancel = True
      Application.EnableEvents = False
        With Intersect(Target.EntireRow, Columns("D"))
          .Value = .Value + Target.Value
        End With
      Application.EnableEvents = True
      Target.ClearContents              '<- Delete if not required
      Range("SearchText").ClearContents '<- Delete if not required
    End If
  End If
End Sub

 

[peteprp]

Peter, that is amazing. Thank you so much.
My apologies for taking so long to reply - I have been working interstate and only got home yesterday. I have had a good 'play' with this today and am very impressed.
I really like the 'clear contents' bit.
I do though have one request - would it be possible for the amount dispensed to be written permanently to column D when the 'enter' key is pressed the first time? I think some people may get confused by having to press the enter key & then double-click to write the amount dispensed permanently to Column D.
I did try entering a negative number as might be the case if trying to cancel an incorrect entry & it worked fine.
Again, thank you. I really appreciate your help with this.