Trying to write and Excel VBA for searching a list of text strings for keywords based on an array and then writing specific values to adjacent cells

[JLoewen]

I am working on a program for assigning ASHRAE room types and specific building code standards to rooms based on their room name.

My approach has been to create worksheets - one with my list of keyword strings, the ASHRAE standard and the room type and another spreadsheet with my actual room names on it and the cells I want the VBA to fill in.

Here's the Room Library sheet - Key word string list, ASHRAE standard corresponding room type.

	Key Word Strings	Ashrae Standard	Room type
1​	Alcove	ASHRAE 170	Patient Corridor
2​	Appointment	ASHRAE 170	Examination room
3​	Appt	ASHRAE 170	Examination room
4​	Breakroom	ASHRAE 62.1	Breakrooms
5​	Canteen	ASHRAE 62.1	Cafeteria/fast-food dining
6​	Classroom	ASHRAE 62.1	Lecture Classroom
7​	Communications	ASHRAE 62.1	Office Space
8​	Conference	ASHRAE 62.1	Conference/meeting
9​	Consult	ASHRAE 170	Examination room
10​	consultation	ASHRAE 170	Examination room
11​	Copy	ASHRAE 62.1	Office Copy, printing rooms
12​	Corridor	ASHRAE 170	Patient Corridor
13​	Cubicle	ASHRAE 62.1	Office Space
14​	Dock	ASHRAE 62.1	SHIPPING/RECEIVING
15​	Exam	ASHRAE 170	Examination room
16​	Hall	ASHRAE 170	Patient Corridor
17​	Kiosk	ASHRAE 62.1
18​	Kitchenette, Lounge	ASHRAE 62.1	Breakrooms
19​	Lactation	ASHRAE 62.1	Office Space
20​	Locker	ASHRAE 62.1	Locker for health care
21​	Lounge	ASHRAE 62.1	Breakrooms
22​	Mail	ASHRAE 62.1	Office Copy, printing rooms
23​	Mech	ASHRAE 62.1	Not Regularly Occupied
24​	Medical, Storage	ASHRAE 170	Sterile Storage
25​	Medication	ASHRAE 170	Medication room
26​	Nurse	ASHRAE 170	Patient Corridor
27​	Office	ASHRAE 62.1	Office Space
28​	Operations	ASHRAE 62.1	Office Space
29​	Procedure	ASHRAE 170	Procedure Room (Class A Surgery)
30​	Procedures	ASHRAE 170	Procedure Room (Class A Surgery)
31​	Reception	ASHRAE 62.1	Reception areas
32​	Secretary	ASHRAE 62.1	Office Space

Here's the sheet with my actual room names on it. The intent is to have a program that searches through the VENTILATION ZONE column for keywords and then assigns the ASHRAE Standard and Room type based on the string found.

Ventilation Zone	ASHRAE Standard	Space Use Category
0111 - EXAM, AUDIO BOOTH
0112 - VENDING
0113 - CANTEEN, PACT 3
0118 - LAB
0119 - COMBINED HYGIENE OPERATORY
0120 - MECH ROOM, DENTAL EQUIP
0121 - SOILED SPD CART
0124 - X-RAY
0126 - DTR
0134 - EXAM/CONSULT
0136 - HEARING AID FITTING
0137 - FITTING & IMMITANCE
0333 - EXAM/CONSULT
0334 - EXAM, AUDIO BOOTH
0335 - EXAM, AUDIO BOOTH
0336 - STORAGE, EQUIP
0341 - STORAGE, INSTRUMENT
0342 - COMBINED HYGIENE OPERATORY
0343 - DTR
0344 - DTR
0345 - DTR
0346 - WORKSTATION, DS
0347 - STAFF LOUNGE
0348 - OFFICE, DENTIST
0349 - WORKSTATION, DS
0350 - WORKSTATION, DS
0351 - RECEPTION
0352 - STORAGE, EQUIP
0353 - TLT, STAFF
0354 - TLT, PAT
0355 - CONFERENCE
0356 - OFFICE, FTE COMMUNITY
0357 - OFFICE, OI&T
0358 - CONFERENCE
0359 - OFFICE, FTE COMMUNITY
0360 - OFFICE, EDUCATOR
0361 - ALCOVE, PRINTER
0362 - OFFICE, EDUCATOR
0363 - STORAGE, EDU MATERIAL
0364 - CONFERENCE
0365 - OFFICE, OI&T
0366 - OFFICE, FMS
0367 - OFFICE, FMS
0368 - REPAIR SHOP, BIOMED
0369 - EXAM
0370 - EXAM, TRAINING
0371 - UTILITY, CLEAN
0372 - UTILITY, SOILED
0373 - OPTICAL SHOP

I have some (very little) experience with VBA programming and want to use this as a learning opportunity. The trouble is I do not know the basics of doing keyword search and match based on multiple arrays. Can you offer a few hints or suggestions?

 

[Fluff]

Why not just use a formula

+Fluff New.xlsm
	A	B	C	D	E	F	G	H
1	Key Word Strings	Ashrae Standard	Room type			Ventilation Zone	ASHRAE Standard	Space Use Category
2	Alcove	ASHRAE 170	Patient Corridor			0111 - EXAM, AUDIO BOOTH	ASHRAE 170	Examination room
3	Appointment	ASHRAE 170	Examination room			0112 - VENDING
4	Appt	ASHRAE 170	Examination room			0113 - CANTEEN, PACT 3	ASHRAE 62.1	Cafeteria/fast-food dining
5	Breakroom	ASHRAE 62.1	Breakrooms			0118 - LAB
6	Canteen	ASHRAE 62.1	Cafeteria/fast-food dining			0119 - COMBINED HYGIENE OPERATORY
7	Classroom	ASHRAE 62.1	Lecture Classroom			0120 - MECH ROOM, DENTAL EQUIP	ASHRAE 62.1	Not Regularly Occupied
8	Communications	ASHRAE 62.1	Office Space			0121 - SOILED SPD CART
9	Conference	ASHRAE 62.1	Conference/meeting			0124 - X-RAY
10	Consult	ASHRAE 170	Examination room			0126 - DTR
11	consultation	ASHRAE 170	Examination room			0134 - EXAM/CONSULT	ASHRAE 170	Examination room
12	Copy	ASHRAE 62.1	Office Copy, printing rooms			0136 - HEARING AID FITTING
13	Corridor	ASHRAE 170	Patient Corridor			0137 - FITTING & IMMITANCE
14	Cubicle	ASHRAE 62.1	Office Space			0333 - EXAM/CONSULT	ASHRAE 170	Examination room
15	Dock	ASHRAE 62.1	SHIPPING/RECEIVING			0334 - EXAM, AUDIO BOOTH	ASHRAE 170	Examination room
16	Exam	ASHRAE 170	Examination room			0335 - EXAM, AUDIO BOOTH	ASHRAE 170	Examination room
17	Hall	ASHRAE 170	Patient Corridor			0336 - STORAGE, EQUIP
18	Kiosk	ASHRAE 62.1				0341 - STORAGE, INSTRUMENT
19	Kitchenette, Lounge	ASHRAE 62.1	Breakrooms			0342 - COMBINED HYGIENE OPERATORY
20	Lactation	ASHRAE 62.1	Office Space			0343 - DTR
21	Locker	ASHRAE 62.1	Locker for health care			0344 - DTR
22	Lounge	ASHRAE 62.1	Breakrooms			0345 - DTR
23	Mail	ASHRAE 62.1	Office Copy, printing rooms			0346 - WORKSTATION, DS
24	Mech	ASHRAE 62.1	Not Regularly Occupied			0347 - STAFF LOUNGE	ASHRAE 62.1	Breakrooms
25	Medical, Storage	ASHRAE 170	Sterile Storage			0348 - OFFICE, DENTIST	ASHRAE 62.1	Office Space
26	Medication	ASHRAE 170	Medication room			0349 - WORKSTATION, DS
27	Nurse	ASHRAE 170	Patient Corridor			0350 - WORKSTATION, DS
28	Office	ASHRAE 62.1	Office Space			0351 - RECEPTION	ASHRAE 62.1	Reception areas
29	Operations	ASHRAE 62.1	Office Space			0352 - STORAGE, EQUIP
30	Procedure	ASHRAE 170	Procedure Room (Class A Surgery)			0353 - TLT, STAFF
31	Procedures	ASHRAE 170	Procedure Room (Class A Surgery)			0354 - TLT, PAT
32	Reception	ASHRAE 62.1	Reception areas			0355 - CONFERENCE	ASHRAE 62.1	Conference/meeting
33	Secretary	ASHRAE 62.1	Office Space			0356 - OFFICE, FTE COMMUNITY	ASHRAE 62.1	Office Space
34						0357 - OFFICE, OI&T	ASHRAE 62.1	Office Space
35						0358 - CONFERENCE	ASHRAE 62.1	Conference/meeting
36						0359 - OFFICE, FTE COMMUNITY	ASHRAE 62.1	Office Space
37						0360 - OFFICE, EDUCATOR	ASHRAE 62.1	Office Space
38						0361 - ALCOVE, PRINTER	ASHRAE 170	Patient Corridor
39						0362 - OFFICE, EDUCATOR	ASHRAE 62.1	Office Space
40						0363 - STORAGE, EDU MATERIAL
41						0364 - CONFERENCE	ASHRAE 62.1	Conference/meeting
42						0365 - OFFICE, OI&T	ASHRAE 62.1	Office Space
43						0366 - OFFICE, FMS	ASHRAE 62.1	Office Space
44						0367 - OFFICE, FMS	ASHRAE 62.1	Office Space
45						0368 - REPAIR SHOP, BIOMED
46						0369 - EXAM	ASHRAE 170	Examination room
47						0370 - EXAM, TRAINING	ASHRAE 170	Examination room
48						0371 - UTILITY, CLEAN
49						0372 - UTILITY, SOILED
50						0373 - OPTICAL SHOP
List

Cell Formulas
Range	Formula
G2:H50	G2	=IFERROR(LOOKUP(10^10,1/(SEARCH($A$2:$A$33,$F2)),B$2:B$33),"")

 

[JLoewen]

I considered a formula (that's something I am pretty good at writing) but decided it probably wasn't the best approach.

The purpose of the VBA is to take a first pass at assigning the room types and ASHRAE codes. I know it will not be able to fill in all of them and that I will be adding more room names/types to the list as I go. I want to be able to add stuff to that list and then re-run the routine.

If I use an excel formula I will have the end user (possibly someone besides myself) erasing excel formulas in two cells and then manually entering data.

With a VBA I can simply have those cells be blank and the user select from a drop-down box to fill in the cells not addressed by the VBA.

 

[Fluff]

Ok, based on the layout in post#2, how about

Sub JLoewen()
   Dim Kary As Variant, Dary As Variant
   Dim i As Long, j As Long
   
   Kary = Range("A2", Range("A" & Rows.Count).End(xlUp).Offset(, 2)).Value
   Dary = Range("F2", Range("F" & Rows.Count).End(xlUp).Offset(, 2)).Value
   For i = 1 To UBound(Dary)
      For j = 1 To UBound(Kary)
         If InStr(1, Dary(i, 1), Kary(j, 1), vbTextCompare) > 0 Then
            Dary(i, 2) = Kary(j, 2)
            Dary(i, 3) = Kary(j, 3)
            Exit For
         End If
      Next j
   Next i
   Range("F2").Resize(UBound(Dary), 3).Value = Dary
End Sub

 

[JLoewen]

I have tried your method and I think I have it duplicated (or at least close) but I am running into an error. The error is Run-time Error 1004 "Method 'Range' of object '_Worksheet' failed.

Here is my code:

Sub AutoAssign()
    Dim RoomName As Variant, Assignments As Variant
    Dim i As Long, j As Long
  
    RoomName = Sheet1.Range("B15", Range("B" & Rows.Count).End(xlUp).Offset(, 3)).Value
    Assignments = Sheet6.Range("B2", Range("B" & Rows.Count).End(xlUp).Offset(, 3)).Value
    For i = 1 To UBound(RoomName)
        For j = 1 To UBound(Assignments)
            If InStr(1, RoomName(i, 1), Assignments(j, 1), vbTextCompare) > 0 Then
                RoomName(i, 3) = Assignments(j, 3)
                RoomName(i, 4) = Assignments(j, 4)
                Exit For
            End If
        Next j
    Next i
    Range("B15").Resize(UBound(RoomName), 3).Value = RoomName
  
End Sub

RoomName is what I am calling my list of room names from the project (your Dary variable). Assignments is what I am calling my ASHRAE room names and code assignments.

I am not very good at reading the syntax of VBA yet. If I am reading your code correctly you are offsetting by the total width of the array minus 1 (3-1 = 2).

I see you are providing code that would be flexible for the length of the input array. I don't anticipate ever working with a building that has more than 2000 rooms so the RoomName variable will likely never be more than cells long. Would it simplify the code if we locked the length?

 

[Fluff]

You need to fully qualify the ranges like

    RoomName = Sheet1.Range("B15", Sheet1.Range("B" & Rows.Count).End(xlUp).Offset(, 3)).Value
    Assignments = Sheet6.Range("B2", Sheet6.Range("B" & Rows.Count).End(xlUp).Offset(, 3)).Value

Otherwise the Range.end(xlup) is trying to work on the active sheet.

 

[JLoewen]

Thanks. That did it.

 

[Fluff]

You're welcome & thanks for the feedback