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

 

[Peter_SSs]

Welcome to the MrExcel board!

I am not sure if I will be able to help anyway, but why would your sample search criteria return only the blue result when the red ones seem to match just as well?

My initial thought is that I doubt this would be feasible without a macro.

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>

 

[peteprp]

Hi Peter,
Thank you for looking at this and your comment. Yes, you quite correct there Peter. If the sample search was 'amox 25 ca', then that would give the result I've referred to. If this is not possible without a macro, then I'm more than happy to go with a macro, but I'm not familiar with macro's. I should do some macro training then!

 

[Peter_SSs]

Yes, I think you will need vba code, particularly since, from your example, you may enter search terms in a different order to how they appear in the cell(s).
At this stage I am only dealing with the search part of your question as I am as yet uncertain what should happen next.

Try these steps in a copy of your workbook. Post back if you are unsure how to implement any of the steps.


1. Set up the sheet with drug names in column A, Units in B, No. dispensed in C and E1 (yellow) will be the cell to enter the text you will be searching for. (If your actual layout is different, we'll worry about that later, but best to test the concept with the layout I have given)

Excel Workbook
	A	B	C	D	E
1	DRUG NAME	UNITS	No. Dispensed	Search components ->
2	Aluminium Chlorohydrate Cream 20%	Ea
3	Aluminium sulphate Solution 20% Spray 25mL	Ea
4	Amethocaine Mimum 0.5% 20's	Per Minum
5	Aminophylline Amps 250mg/10ml	Per Amp
6	Amiodarone Inj 150mg/3mL	Per Amp
7	Amlodipine Tabs 10mg	Per Tab
8	Amoxycillin 100mg Drps	Ea
9	Amoxycillin 400mg, clavulanate 57mg Syr	Ea
10	Amoxycillin 875mg, clavulanate 125mg Tabs	Per Tab
11	Amoxycillin Amps 1gm	Per Vial
12	Amoxycillin Caps 250mg	Per Caps
13	Amoxycillin Caps 500mg	Per Caps
14	Amoxycillin Syrup SF 125mg/5ml	Ea
15	Amoxycillin Syrup SF 250mg/5ml	Ea
16	Antazoline/ Naphazoline Eye Drops	Ea
17	Aqueous Cream 100g cream	Ea
18	Artesunate Inj 60mg	Per Vial
Sheet1

2. Select E1 and make it a named range with name SearchText

3. Right click the sheet name tab and choose "View Code".

4. Copy and Paste the code below into the main right hand pane that opens at step 3.

5. Close the Visual Basic window & test by entering/altering/deleting text in cell E1. (Clearing cell E1 will display all data.)

6. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm).

If it works for you, after entering something (or nothing) in cell E1, the list should be filtered to show the rows that match your search criteria in E1. So entering
amox 25 c should show 4 rows,
amox 25 ca should show 1 row,
Amixycillin should show no rows (incorrect spelling).

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 = 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 = Replace(s, " ", "|")
        sTest1 = "|" & Replace(RX.Pattern, "|", "||") & "|"
        aNames = .Columns(1).Value
        For i = 2 To UBound(aNames)
          Set M = RX.Execute(aNames(i, 1))
          If M.Count >= NumStrings Then
            sTest2 = sTest1
            For Each itm In M
             sTest2 = Replace(sTest2, "|" & itm & "|", "", 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

Here is my sheet again, after entering some text in E1

Excel Workbook
	A	B	C	D	E
1	DRUG NAME	UNITS	No. Dispensed	Search components ->	syr 25 amox
14	Amoxycillin Syrup SF 125mg/5ml	Ea
15	Amoxycillin Syrup SF 250mg/5ml	Ea
19
Sheet1

 

[peteprp]

Peter, That is amazing. Its taken me a while to complete the instructions but unfortunately, I can't get it to work. I get the following message
'Run-time error '1004'
Method 'Range' of object '_Worksheet' failed
When clicking the debug button, it shows
Set rSch = Range("SearchText")
I think the problem might be with the range specifications of 'SearchText'.
I really appreciate your time in writing the code and replying to me.
Would it be easier to send you the file by email?
Thanks again
Pete

 

[Peter_SSs]

Would it be easier to send you the file by email?

No, that is not allowed under the Forum Rules (ref #4 in particular)

I get the following message
'Run-time error '1004'
Method 'Range' of object '_Worksheet' failed
When clicking the debug button, it shows
Set rSch = Range("SearchText")

It seems like you have made a mistake at step 2.
Select E1 then in the Name Box (the box at the very left beside the formula bar), type SearchText and press Enter

Then try again entering a value in E1

 

[peteprp]

No, that is not allowed under the Forum Rules (ref #4 in particular)


It seems like you have made a mistake at step 2.
Select E1 then in the Name Box (the box at the very left beside the formula bar), type SearchText and press Enter

Then try again entering a value in E1

Hi Peter, I followed exactly the above (on a clean new sheet) and I get a Run-time error 429 and the debug button shows Set RX = CreateObject("VBScript.RegExp")
Sorry to be a pain in the butt.
Pete

 

[Peter_SSs]

Hmm, using an Apple operating system & Excel version?

 

[peteprp]

Hmm, yes. Sorry Peter, should have mentioned that earlier. A MacBook Pro and Office 365 for Mac.

 

[Peter_SSs]

Hmm, yes. Sorry Peter, should have mentioned that earlier. A MacBook Pro and Office 365 for Mac.

Probably a good idea. Although there are quite a few Mac helpers on the forum, by far the majority are PC/Windows users.
I don't use or have a Mac system to check so the best I can offer is to see if this helps. If not I doubt that I will be able to help further.