Generating an array, and using Vlookup to loop through this array (VBA)

[georgedixon]

Hi,
using the following code i have tried to generate an array based on what is in column "LN", (all values in "LN" are named ranges, corresponding to different cells). Then using vlookup I want it to look at cell d25, and look for a match within every named range of the array.




Sub testfind()




Sheets(“Sheet5”).Select


Dim arr() As Variant


arr() = Sheets("Sheet5").Range("LN4:LN" & LRow).Value




Dim I As Long
For I = 1 To Range("LN").End(xlUp).Value

Sheets(“Estimation - Entry”).Select
Range("P40").Value = arr(1)
Range(“E25").Value= Vlookup((Range(“D25").Value),(Range(arr(i)).Value),2,0)**************************************** ****


End Sub







First of all, I am unsure whether my array is even set up correctly, and upon running, the part that does not work, is the one with the following beside it: *********. Any help is appreciated, thanks :)

[SamT]

I'm pretty sure that each Cell in LN has a Formula like "=Name". But the Value of the Cell is = the value of the Named Range, so "arr = BlahBlah.Value" fills the arr Array with the Values of all those Named Cells.

"arr = BlahBlah", OTOH, fills the array with the actual Ranges. To reference the Value of one of them use "X = arr(i).Value."
To reference the Formula or Range Name, use "X = arr(i).Formula" or "X = Mid(arr(i).Formula, 2)"

I am completely at a loss as to what you want in Range("E25")

[georgedixon]

oh ok thanks :) For the Range("E25"), i was trying to make the code, put in E25, a vlookup that would search through every part of the array, hence the failed attempt at a loop

[SamT]

oh ok thanks :) For the Range("E25"), i was trying to make the code, put in E25, a vlookup that would search through every part of the array, hence the failed attempt at a loop

Uhhh... You wanted to put a Formula in E25 that would run the VLookUp Function on a VBA Array?

[georgedixon]

Yes, the reason i was doing it on vba is because i want it to search through the set of named ranges (i.e. the created array) to match (also wanted to add an if statement at a later point)

[SamT]

Yes, the reason i was doing it on vba is because i want it to search through the set of named ranges (i.e. the created array) to match (also wanted to add an if statement at a later point)

That's not hard with VBA. but... Match what? What Value do you want in E25? Where does it come from? How do I find it?

Forget VLookUp. VBA uses Index and/or Match to do what V&H-LookUps do for Excel. Arrays might use a different method.

[Paul_Hossler]

@georgedixon --


This is a little confusing for me -- can you post a small workbook that contains enough dummy data to show exactly what you're wanting to do?

[georgedixon]

Hi, i have attached the test file that i was using previously... i essentially want it to do what it already does, however within VBA

[georgedixon]

"F3" is the formula i would like to replicate in VBA ( i will be using it to search across a lot more sets of data than the test doc)

[Paul_Hossler]

Something like this maybe?

If this is part of a larger macro, the init logic would only need to be done one time

I think that by rearranging the data tables, the init logic could be simplified

It needs error checking




Option Explicit
Sub drv()
MsgBox LookupValue("option1", "one")
MsgBox LookupValue("option2", "four")
MsgBox LookupValue("option3", "ten")
End Sub

Function LookupValue(opt As String, test As String) As Variant
Dim tabCollection As Collection, tstCollection As Collection
Dim tabData As Range, tstData As Range
Dim r As Long

On Error GoTo NiceExit

Application.Volatile

'this is just setup
Set tabData = Worksheets("option data").Range("D2:E4")
Set tabCollection = New Collection
Set tstCollection = New Collection

With tabData
If .Cells(1, 1).End(xlDown).Row = .Parent.Rows.Count Then 'only one
tabCollection.Add .Cells(1, 2).Value, .Cells(1, 1).Value
Else
For r = 1 To .Rows.Count
tabCollection.Add .Cells(r, 2).Value, .Cells(r, 1).Value
Next r
End If
End With

With Worksheets("Sheet1")
Set tstData = .Range("K3").CurrentRegion
tstCollection.Add tstData.Cells(2, 1).Resize(tstData.Rows.Count - 1, tstData.Columns.Count), tstData.Cells(1, 1)
Set tstData = .Range("O3").CurrentRegion
tstCollection.Add tstData.Cells(2, 1).Resize(tstData.Rows.Count - 1, tstData.Columns.Count), tstData.Cells(1, 1)
End With

'real work to find the value
Set tabData = tstCollection(tabCollection(opt))
LookupValue = Application.WorksheetFunction.VLookup(test, tabData, 3, False)
'cleanup
Set tabCollection = Nothing
Set tstCollection = Nothing

Exit Function
NiceExit:
LookupValue = CVErr(xlErrNA)

End Function

[Paul_Hossler]

Above was a function, but if you just want a sub, then maybe something like this




Option Explicit

Sub LookupValue()
Dim tabCollection As Collection, tstCollection As Collection
Dim tabData As Range, tstData As Range
Dim r As Long
Dim opt As String, test As String

On Error GoTo NiceExit




'this is just setup
opt = Worksheets("Sheet1").Range("C3").Value
test = Worksheets("Sheet1").Range("D3").Value

Set tabData = Worksheets("option data").Range("D2:E4")
Set tabCollection = New Collection
Set tstCollection = New Collection

With tabData
If .Cells(1, 1).End(xlDown).Row = .Parent.Rows.Count Then 'only one
tabCollection.Add .Cells(1, 2).Value, .Cells(1, 1).Value
Else
For r = 1 To .Rows.Count
tabCollection.Add .Cells(r, 2).Value, .Cells(r, 1).Value
Next r
End If
End With
With Worksheets("Sheet1")
Set tstData = .Range("K3").CurrentRegion
tstCollection.Add tstData.Cells(2, 1).Resize(tstData.Rows.Count - 1, tstData.Columns.Count), tstData.Cells(1, 1)
Set tstData = .Range("O3").CurrentRegion
tstCollection.Add tstData.Cells(2, 1).Resize(tstData.Rows.Count - 1, tstData.Columns.Count), tstData.Cells(1, 1)
End With

'real work to find the value
Set tabData = tstCollection(tabCollection(opt))
Worksheets("Sheet1").Range("F3").Value = Application.WorksheetFunction.VLookup(test, tabData, 3, False)
'cleanup
Set tabCollection = Nothing
Set tstCollection = Nothing

Exit Sub
NiceExit:
Worksheets("Sheet1").Range("F3").Value = CVErr(xlErrNA)

End Sub

[georgedixon]

Thanks, might sound like a stupid question, but is there a way to make it run as soon as something is changed within the dropdown?

[Paul_Hossler]

Not stupid question at all

Use a worksheet event handler on Sheet1 (see screen shot and the macro below)

I did change the call to the sub a little to pass parameters so you might want to look at that in the attachment

20387



Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$3" Or Target.Address = "$D$3" Then
Application.EnableEvents = False
Call LookupValue(Range("C3"), Range("D3"), Range("F3"))
Application.EnableEvents = True
End If
End Sub

[georgedixon]

Thanks again, I am trying to adapt this code so that it searches through 60 different named ranges, rather than just the "test1" and "test2" columns, which bits will i need to change?

[Paul_Hossler]

Thanks again, I am trying to adapt this code so that it searches through 60 different named ranges, rather than just the "test1" and "test2" columns, which bits will i need to change?

What do the Named Ranges look like?

Are they all from one sheet?

Do they all have a consistent / logical naming convention?

Do you have them in a list?

[georgedixon]

These are all the named ranges, they are stored on "Sheet5", I originally tried to store all of these as an array so that the code would filter through them but i could not get it to work. (Each named range is a 3 column wide range (different number of rows in each))

(Primer_FlatRoof,Felt_System_SIG,MasticAsphalt,Trim_TerminationBar_Breather Vent,Surface_finishes,IKO_Felt_Materials,IKO_Polimar_Materials,PitchedRoof_ Insulation,PitchedRoof_Underfelt,Valley_Undercloak_HipIrons,Ventilation,Pla inTiles_RedlandConcrete,RedlandConcrete_Tiles,PlainTiles_MarleyConcrete,Pla inTiles_RedlandClay,PlainTiles_MarleyClay_SingleCamberOnly,Ridges_Hips_Bonn ets_Concrete,Ridges_Hips_Bonnets_Clay,Slating_Man_Made_Thrutone,Slating_Spa nish_NaturalSlates,Slating_Welsh_NaturalSlates,Guttering_PVC_Half_Round_112 mm,Downpipe_PVC_68mmRound_Hopperhead,Guttering_PVC_HiCap_HalfRound,Downpipe _PVC_80mmRound_Hopperhead,Guttering_PVC_170mmSemiElliptical,Downpipe_PVC_11 0mmRound_Hopperhead,CastIron_Gutters_Downpipes_112mm,Gutter_Miscellaneous,S umo_Square_Fascia_20mm,S16_Square_Fascia_16mm,Upvc_Refurb_Fascias_9mm_Cover _Board,Refurbishment_Fascia_Econocap_Fascia_7mm,Soffits_Vented_9mm_10mm_Air Gap_15Degree,Soffit_FlatBoard_9mm,Soffit_Accessories,Upvc_Cladding,Flashban d,Acrypol_Allweather_Brush,Giromax_Seamsil,Giromax_HPG_Gutter_System,Giroma x_Delcote_Coating,Unifold_Gutter_Liner,Oversheet_GRP_Fibre_Cement_Sheeting, Decktites,PPE,Brushes_Rollers_Brooms_Mops,Mastics_Sealant_PU_Adhesives,Prop ane_Gas,Brickwork_Materials,OSB,Angle_fillet,Batten,Miscellaneous_,LeadFlas hings_Aprons,Ubbiflex_Substitute_Lead_Flashings,Galvanised,Alloy,Copper,Scr ews)

[Paul_Hossler]

Little hard to decipher

Can you post a workbook with just Sheet5 and which has the named ranges defined

[georgedixon]

I can't really do that, the data within these named ranges is quite sensitive.

I have attached a copy of the "Sheet5" without all of the data within the named range... they are all these separate tables (the reason I have separated them, is because i was going to enable the user to add extra entries in each category and adjusting the named range)

The named ranges are all still set on this sheet, and at the end of all tables (horizontal) is a list of all the named ranges.

[SamT]

Sub t()
Dim MyNames, Nm, X


MyNames = Array("Acrypol_Allweather_Brush", "Alloy", "Angle_fillet", "Batten", "Brickwork_Materials", "Brushes_Rollers_Brooms_Mops", _
"CastIron_Gutters_Downpipes_112mm", "Copper", "Decktites", "Downpipe_PVC_110mmRound_Hopperhead", _
"Downpipe_PVC_68mmRound_Hopperhead", "Downpipe_PVC_80mmRound_Hopperhead", "Felt_System_SIG", _
"Flashband", "Galvanised", "Giromax_Delcote_Coating", "Giromax_HPG_Gutter_System", "Giromax_Seamsil", _
"Gutter_Miscellaneous", "Guttering_PVC_170mmSemiElliptical", "Guttering_PVC_Half_Round_112mm", _
"Guttering_PVC_HiCap_HalfRound", "IKO_Felt_Materials", "IKO_Polimar_Materials", "LeadFlashings_Aprons", _
"MasticAsphalt", "Mastics_Sealant_PU_Adhesives", "Miscellaneous_", "OSB", "Oversheet_GRP_Fibre_Cement_Sheeting", _
"PitchedRoof_Insulation", "PitchedRoof_Underfelt", "PlainTiles_MarleyClay_SingleCamberOnly", _
"PlainTiles_MarleyConcrete", "PlainTiles_RedlandClay", "PlainTiles_RedlandConcrete", "PPE", "Primer_FlatRoof", _
"Propane_Gas", "RedlandConcrete_Tiles", "Refurbishment_Fascia_Econocap_Fascia_7mm", "Ridges_Hips_Bonnets_Clay", _
"Ridges_Hips_Bonnets_Concrete", "S16_Square_Fascia_16mm", "Screws", "Slating_Man_Made_Thrutone", _
"Slating_Spanish_NaturalSlates", "Slating_Welsh_NaturalSlates", "Soffit_Accessories", "Soffit_FlatBoard_9mm", _
"Soffits_Vented_9mm_10mm_AirGap_15Degree", "Sumo_Square_Fascia_20mm", "Surface_finishes", _
"Trim_TerminationBar_BreatherVent", "Ubbiflex_Substitute_Lead_Flashings", "Unifold_Gutter_Liner", _
"Upvc_Cladding", "Upvc_Refurb_Fascias_9mm_Cover_Board", "Valley_Undercloak_HipIrons", "Ventilation")


For Each Nm In ThisWorkbook.Names
X = 0
On Error Resume Next
X = WorksheetFunction.Match(Nm.Name, MyNames, 0)
Err = 0
If X <> 0 Then X = Nm.RefersTo
'
'
'
'
'
'
Next


End Sub

[Paul_Hossler]

I can't really do that, the data within these named ranges is quite sensitive.

I have attached a copy of the "Sheet5" without all of the data within the named range... they are all these separate tables (the reason I have separated them, is because i was going to enable the user to add extra entries in each category and adjusting the named range)

The named ranges are all still set on this sheet, and at the end of all tables (horizontal) is a list of all the named ranges.

You really don't need all those range names; it's a nightmare to maintain

Look at the attachment and see what you think. Post questions, comments, complaints



Sheet5 has some dummy data for the first two categories. I assumed that there had to be 3 columns to use for the dropdowns

20403

Sheet1 has the dropdowns

WB_Open initializes the collections, etc., but it just calls a macro which you can call directly

[snb]

Make a simple database in 1 sheet, 4 columns : product / type / code / price.
You can filter (1 or more) based on each (combination of) product / type / code / price.
Eventually 'finding' and 'filtering' are identical.

[georgedixon]

I don't think I can get rid of the named ranges, these are the names of which the dropdown will seek its data (from data validation method). The reason I've put it in this layout, is so that at a later point, i can set up a form, where a user can add an item to each named range, and thus the dropdown. Is there a more effective way that I could do this (and would it involve restarting the whole thing?)

[Paul_Hossler]

In ver 3 attached to the previous post, when the WB opens it builds a collection with each of the 3 column blocks of data, keyed by the block name, and a list of the categories

Sheet1 C3 using this list to pick from

The Sheet1 Change handler takes the category selected from the drop down in C3 and builds the DV list for D3 using the category name and the data in that collection item for the D3 drop down

So depending on that you're doing, you should be able to do something similr



Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mtlValidation As Range

If Target.Address = "$C$3" Then
Application.EnableEvents = False
Range("E3").ClearContents
Range("F3").ClearContents

Set mtlValidation = catCollection(Range("C3"))
Set mtlValidation = mtlValidation.Cells(2, 1).Resize(mtlValidation.Rows.Count - 1, 1)


'add data validation to category
With Range("D3").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="='" & catWorksheet.Name & "'!" & mtlValidation.Address
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Range("D3").Value = "Code"

Application.EnableEvents = True


ElseIf Target.Address = "$D$3" Then
Application.EnableEvents = False
Call LookupCost(Range("C3"), Range("D3"), Range("E3"), Range("F3"))
Application.EnableEvents = True
End If

End Sub

[georgedixon]

Thank you, I am currently attempting to transfer this code to my actual document. I just did a test on it (on the test sheet), to see if I added an extra entry to the table, whether or not this would automatically be added to the drop downs by the "build category" function. However when tested It does not seem to have worked, would i need to re-run the code or am i misinterpreting what that code does?

[Paul_Hossler]

Thank you, I am currently attempting to transfer this code to my actual document. I just did a test on it (on the test sheet), to see if I added an extra entry to the table, whether or not this would automatically be added to the drop downs by the "build category" function. However when tested It does not seem to have worked, would i need to re-run the code or am i misinterpreting what that code does?

The collections used for the dropdowns are built when the workbook opens

If you add values, you can just run the macro 'BuildCategories' manually to re-build the collections, or save and re-open he workbook

You can add a Sheet5 event handler to automatically re-build when you change it if you want

[georgedixon]

Thanks again, sorry to be a pain. But the layout of my actual document is slightly more complex (actually a 3-tier drop down system). I am thinking that I'll need to add another sub to essentially build the second category as well as the third. I have attached an adapted version of the test doc, which explains what I am trying to do, if you could take a look and point me in the right direction that'd be great. Thanks again for your help, it is massively appreciated. :)

[SamT]

I started in Excel and VBA being a believer in Named Ranges, (Technically: Named Formulas,). Impossible to maintain and any User can fubar the whole thing. Later I had to develop a workbook that had thousands of small, User Defined and maintained lists. This code is similar to what I used there.

Now, I strongly believe that the only use for Named Formulas is in Excel Worksheet Formulas, and I much prefer that anything VBA needs, should be provided by VBA.

Place copies in each Worksheet that provides Named Ranges to VBA

Option Explicit

Public Function GetList(ListName As String) As Variant
'Worksheet Module Code to replace Named Ranges in VBA

Dim FoundList As Range

Set FoundList = Cells.Find(What:=ListName, After:=Cells(1), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)

If FoundList Is Nothing Then
MsgBox "That List Name was not Found on Sheet1" 'Name of sheet this function is in. Edit to suit
Exit Function
Set FoundList = FoundList.CurrentRegion
End If

'To Return an array of Values with header
'GetList = FoundList.Value

'To Return an array of Values with no header
GetList = FoundList.Offset(1).Resize(FoundList.Rows.Count - 1, FoundList.Columns.Count).Value

'To Return a Range
'Set GetList = FoundList.Offset(1).Resize(FoundList.Rows.Count - 1, FoundList.Columns.Count)

End Function

[Paul_Hossler]

Seems to me that the data structure is the most important aspect

How would something like this as a 'database' work for you? The actual dropdown pick lists are easy

Three levels

L1 - Category
L2 - Subsystem
L3 - Component

To define what subsystems are in a category (or categories), and what components are in a subsystem (or subsystems), to need to create a 'relational' data structure


20431

If it's not useful, than I won't pursue it this way

[SamT]

Note the lack of any special formatting of the Names in this example that my code above can work with


Roof Systems

Flat Roof Primer
Code
Price

Felt System SIG
Code
Price

Mastic Asphalt
Code
Price


Flat Roof Primer

Red
RR
£11.00

5 lb
5
£200.00






Felt System SIG

Green
GG
£22.00

10 lb
10
£400.00






Mastic Asphalt

Blue
BB
33

15 lb
15
£600.00






Breather Vent Trim: Termination Bar

Copper
Cu
44

20 lb
20
£800.00






Surface Finishes

White
WW
55

30 lb
30
£1,000.00






IKO Felt Materials

dfgsdg
sdgsdg
22

100 lb
100
£1,500.00






IKO Polimar Materials
















You can even have the same List Name on multiple sheets

[georgedixon]

Sorry I have taken ages to reply, I have just started back at uni and have been crazy busy for the last few days. I think that database method could be very useful if it is able to be implemented. The only thing is, the system I am creating uses more than one, 3 tier drop down list. It essentially has 20 or so rows of the same drop down menus and allows you to enter quantity, and from this essentially is a shopping list, which totals the costs. I have showed a basic, similar layout on the attached spreadsheet. Thanks

[georgedixon]

///

[Paul_Hossler]

Ref: Your PM

Look at the picture in #28, which is 'sort of' a relational base which defines what is in each group of sub-group.

There are as I understand it, three levels:

L1 - Category
L2 - Subsystem
L3 - Component

(L1) Category dropdowns are in A:A

(L2) Subsystems (my term) in each category are in D:E

(L3) Components to be costed in each subsystem are in H:I, with the component code in J and the Unit Cost in K


So a ConOps might be a Costing worksheet with rows to be filled in with these column headers:


COL A B C D E F G
CATEGORY -- SUBSYSTEM -- COMPONENT -- CODE -- UNITCOST -- QTY -- EXTCOST

1. Pick Category in col A from L1 dropdowns (e.g. 'FlatRoof') - also determines L2 drop downs from E for category = D

2. Pick Subsystem in col B from L2 dropdowns (e.g. 'Felt System SIG') - also determines Components from I for subsystem = H

3. Pick Component in col C from L3 dropdowns (e.g. '10 lbs') - also determines Code (D) and unit cost (E)

3. Enter qty for Component in C in col F, which determines extended cost


By using two columns (D:E) for Category+System I think it's easier to maintain since you don't need lots of little block of data

Data reporting would be using pivot tables, or something

[georgedixon]

Thanks, I am currently trying to learn how to create these pivot tables.. I am unsure how to do it correctly. On sheet 2 (of the attached sheet), I have attempted to create a database which generates a pivot table on sheet 6. But I am unsure as to how this could be used for the drop down menus.

[Paul_Hossler]

I'm trying to put together an example that might give you some ideas

Day or two maybe

[georgedixon]

Thanks :)

[Paul_Hossler]

Took a little longer that I planned to put a ConOps sample together (grandkids were here)

Seems to me the biggest part is defining the relationships between the levels of data and doing so in such a way that Excel can easily use the information

So what I did is (you can see in the attachment)

Data:

1. Create a 1 column list of Categories as level 1
2. Create a 2 column list of Category+Subsystem as level 2
3. Create a 2 column list of Subsystem+Component as level 3
4. Create a Unit Cost list 'keyed' by Component

Working:

5. A materials list where you pick the Category (Col A) from a dropdown (#1 above)
which populates another dropdown (Col B) with the Subsystems for that Category (from #2)
which populates another dropdown (Col C) with the Components for that Subsystems (from #3)

6. Picking a Component populates the Unit Cost, etc. including some formulas

7. When you put in the quantity, the extended cost is calculated


Reports:

The Working sheet is not used for reports, but it is pivot table friendly

8. I added some sample / typical pivot tables to look at


If this seems complicated, it's because it is complicated


I mocked up some data, and hardcoded some dropdown to demonstrate. Only the GREEN data actually is tied in

[georgedixon]

Hi, Thank you so so much.

I am not sure if I am getting confused.. but on the "Working Sheet" the first column "Category", the drop-down options are there, but when pressed they do not force the following cells to repopulate (the top half of the table is fixed on the category "Flat_Roof" and the second "Pitched_Roof"). If you could let me know if this was intentional and how I can fix, that'd be great.

Thanks again you're being extremely helpful.

Kind Regards,
George :)

[Paul_Hossler]

There's no 'automation' in the WB. The address of the level2 and level3 dropdowns are hard coded

I wanted to see if you thought it was worth pursuing using this approach

If you are, then the next step would be to changed the level 2 dropdown values depending on the Category selection, etc.

[georgedixon]

Oh ok, yes this would be very useful. Just out of curiosity, is it easy to manipulate the pivot tables by the use of VBA code (as after this is complete I may create a user form so that a user can add to the categories)? Thanks Again,

George

[Paul_Hossler]

Next version

Difficult to do realistic example since I don't have your data, so I just made some up, and I called the 3 Bill of Materials levels Category, Subsystem, Components (which have unit price and carry the costs)

4 data sheets to be set up

1. List of Categories (Col A)
2. List of Categories (Col A) with potential Subsystems (Col B) -- it's a 1-many relationship
3. List of Subsystems (Col A) with potential Components (Col B) -- it's a 1-many relationship
4. Unit prices for Components


Working

Select Col A (Category) generates dropdown from #1 above
Select Col B (Subsystem) generates dropdown from #2 above for the Subsystems in the Category in Col A
Select Col C (Component) generates dropdown from #3 above for the Components in the Subsystem Col B
Select Component added formula for Unit Cost, and Code (from #4 above) and Extended Cost in Col F -- you just need to enter quantity


Pivot Table reports

Exiting 'Working' will refresh any pivots in the workbook


If you don't want to pursue this approach it's OK -- I had fun

[georgedixon]

Thank you so much, I definitely will pursue this... I will attempt to change the tables for my own data over the next few days. I will let you know how I get on. Thanks again :)