Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 433
  • Last Modified:

VBA in Excel filtering a sheet based on another sheets values

I have three sheets in my workbook:

ProductList
Values
Output

The ProductList sheet only contains one column and 3 - 11 rows typically, depending on what the process is waiting to consume from the Output sheet. (it gets turned into a flat file and processed downstream, which again we have no control over)  If we send it all 4,000 products - all of them will be processed which will get me fired.

The values sheet is populated with an array of information on products from an existing macro that cannot be edited since it is from our vendor.  So in this sheet it has product name, price, product ID, description, category, etc.

The Output sheet has to retrieve data from the Values sheet and do substitutions, math, etc. on them based on the product which all works fine.  BUT we do not want all the products listed in the output, just what we want to process at the time.  We need the price, description, product ID, etc. but the product name can only match those in the ProductList sheet.

Example:

We list 3 things in the ProductList sheet:

Bearings
Belts
Motors

We need to limit the Output sheet to only contain those three types of items.  In the Values sheet there could be 45 different bearings, 20 mufflers, 9 belts, 50 tires, and 10 motors.

Each of those items having all the attributes mentioned before: price, description, product ID, category, etc.  (All data looks identical in terms of datatype and all have the values filled in for price, description, product ID, category)

How can we build into a macro to only pull from the Values sheet what exists in the ProductList sheet (which will then be pushed to the Output sheet after some processing)?

This is an automated process whereby the user enters the category of the items he/she wants processed in the ProductList sheet then clicks a button attached to a macro that kicks off different processing.  

Any help would be greatly appreciated.

Thanks in advance,

B
0
cyimxtck
Asked:
cyimxtck
  • 9
  • 7
  • 4
  • +1
1 Solution
 
[ fanpages ]IT Services ConsultantCommented:
Hi B,

Is there any chance you can provide an example workbook to understand the concept?

I appreciate you will not wish to publish your organisation's core list, but perhaps you can offer sample data that provides at least one example output that you are trying to achieve.

Thanks for your consideration.

BFN,

fp.
0
 
cyimxtckAuthor Commented:
I would love to give you something "real" but cannot based on our companies policy but what I will do is mock something up and change all the values to something else.

Please find that attached.

Thanks,

B
Example.zip
0
 
cyimxtckAuthor Commented:
So the Output tab is what should happen based on the values in the ProductList tab by pulling those values in a macro from the Values tab.
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
Saqib Husain, SyedEngineerCommented:
Try

Sub summrz()
Dim tws As Worksheet
Dim sws As Worksheet
Dim cws As Worksheet
Set tws = Worksheets("Output")
Set sws = Worksheets("Values")
Set cws = Worksheets("ProductList")
tws.Cells.ClearContents
tws.Range("1:1").Value = sws.Range("1:1").Value
tws.Range("A2").Resize(WorksheetFunction.CountA(cws.Range("A:A"))).Value = cws.Range("A1").Resize(WorksheetFunction.CountA(cws.Range("A:A"))).Value
tws.Range("A2").Offset(, 1).Resize(WorksheetFunction.CountA(cws.Range("A:A")), 3).FormulaR1C1 = "=VLOOKUP(rc1,Values!c1:c4,COLUMN(),0)"
tws.Range("A2").Offset(, 1).Resize(WorksheetFunction.CountA(cws.Range("A:A")), 3).Value = tws.Range("A2").Offset(, 1).Resize(WorksheetFunction.CountA(cws.Range("A:A")), 3).Value
End Sub

Open in new window

0
 
Anthony MellorChartered AccountantCommented:
An MS Query Inner Join does that I think.

Example attached:

I added a column head in Product list sheet.

the filename is hardwired so don't change it without editing it.
the file's path is assumed to be your default file location as per Excel Options Save
All this can be written in VBA (except not by me).
Output can be pivot table if desired.
MS Query is via Data menus to MS Query.
Example.xlsx
0
 
[ fanpages ]IT Services ConsultantCommented:
Hi again,

Thanks for your workbook.

I have attached a workbook containing the following code (within the code module of the [Output] worksheet):

Option Explicit
Private Sub Worksheet_Activate()

' --------------------------------------------------------------------------------------------------------------
' [ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28129295.html ]
'
' Question Channel: Experts Exchange > Software > Office / Productivity > Office Suites > MS Office > MS Excel
'
' ID:               28129295
' Question Title:   VBA in Excel filtering a sheet based on another sheets values
' Question Asker:   cyimxtck
' Question Dated:   2013-05-15 at 21:08:52
'
' Expert Comment:   fanpages
' Copyright:        (c) 2013 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
' --------------------------------------------------------------------------------------------------------------

  Dim blnApplication_ScreenUpdating                     As Boolean
  Dim lngErr_Number                                     As Long
  Dim objADODB_Connection                               As Object
  Dim objADODB_Recordset                                As Object
  Dim strSQL                                            As String
  Dim strErr_Description                                As String
 
  On Error GoTo Err_Workbook_SheetActivate
 
  blnApplication_ScreenUpdating = Application.ScreenUpdating
  Application.ScreenUpdating = False
  
  Set objADODB_Connection = CreateObject("ADODB.Connection")
 
  objADODB_Connection.Provider = "Microsoft.Jet.OLEDB.4.0"
  objADODB_Connection.ConnectionString = "Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=Excel " & _
                                          IIf(Val(Application.Version) <= 11#, "8", "12") & ".0;"
  objADODB_Connection.Open
 
  strSQL = ""
  strSQL = strSQL & "SELECT "
  strSQL = strSQL & "[Category],"
  strSQL = strSQL & "[Price],"
  strSQL = strSQL & "[Description],"
  strSQL = strSQL & "[ProductID] "
  
  strSQL = strSQL & "FROM "
  strSQL = strSQL & "[EXCEL " & _
                     IIf(Val(Application.Version) <= 11#, "8", "12") & ".0;"                                                                            ' Note: Val(...) only recognizes a period ["."] as a valid decimal separator
  strSQL = strSQL & "IMEX=1;"
  strSQL = strSQL & "HDR=Yes;"
  strSQL = strSQL & "DATABASE=" & ActiveWorkbook.FullName & "].[Values$] As V "
 
  strSQL = strSQL & "LEFT JOIN "
  strSQL = strSQL & "[EXCEL " & _
                     IIf(Val(Application.Version) <= 11#, "8", "12") & ".0;"                                                                            ' Note: Val(...) only recognizes a period ["."] as a valid decimal separator
  strSQL = strSQL & "IMEX=1;"
  strSQL = strSQL & "HDR=No;"
  strSQL = strSQL & "DATABASE=" & ActiveWorkbook.FullName & "].[ProductList$] As P "
  strSQL = strSQL & "ON "
  strSQL = strSQL & "[V].[Category]=[P].[F1]"
  
  strSQL = strSQL & "WHERE "
  strSQL = strSQL & "[P].[F1] = [V].[Category]"
  
  Set objADODB_Recordset = CreateObject("ADODB.Recordset")
 
  objADODB_Recordset.CursorType = 3                                                                                                                     ' adOpenStatic
  objADODB_Recordset.CursorLocation = 3                                                                                                                 ' adUseClient
  objADODB_Recordset.ActiveConnection = objADODB_Connection
 
  objADODB_Recordset.Open (strSQL)
 
  Cells.ClearContents
  Worksheets("Values").Rows(1&).Copy Worksheets("Output").Rows(1&)
  [A2].CopyFromRecordset objADODB_Recordset
 
Exit_Workbook_SheetActivate:

  On Error Resume Next
 
  [A2].Select
 
  If Not (objADODB_Recordset Is Nothing) Then
     objADODB_Recordset.Close
     Set objADODB_Recordset = Nothing
  End If
 
  If Not (objADODB_Connection Is Nothing) Then
     objADODB_Connection.Close
     Set objADODB_Connection = Nothing
  End If

  Application.ScreenUpdating = blnApplication_ScreenUpdating
  
  Exit Sub
 
Err_Workbook_SheetActivate:

  lngErr_Number = Err.Number
  strErr_Description = Err.Description
  
  On Error Resume Next
  
  Application.ScreenUpdating = True
  
  MsgBox "Error #" & CStr(lngErr_Number) & _
          vbCrLf & vbLf & _
          strErr_Description, _
          vbExclamation Or vbOKOnly, _
          ActiveWorkbook.Name
         
  Resume Exit_Workbook_SheetActivate
 
End Sub

Open in new window


The contents of the [Output] worksheet will change according to the contents of the other two worksheets once the [Output] worksheet is activated (selected).

In order to review the attachment, please ensure you save this workbook to a physical location upon your local hard drive rather than simply opening from your web browser (cache).

BFN,

fp.
Q-28129295.xls
0
 
cyimxtckAuthor Commented:
"Could not find installable ISAM" is the error message I have gotten BFN
0
 
Saqib Husain, SyedEngineerCommented:
Did you try the previous code?
0
 
[ fanpages ]IT Services ConsultantCommented:
"Could not find installable ISAM" is the error message I have gotten BFN

gotten?

Is that German?

Either way, which version of Microsoft Excel are you using?  2007, 2010, or 2013?
0
 
[ fanpages ]IT Services ConsultantCommented:
I have made a slight change to the code.

This line (#32 in the code above):
objADODB_Connection.Provider = "Microsoft.Jet.OLEDB.4.0"

Open in new window


Now reads:
objADODB_Connection.Provider = "Microsoft." & IIf(Val(Application.Version) <= 11#, "Jet.OLEDB.4.0", "ACE.OLEDB.12.0")

Open in new window


Another sample workbook is attached.
Q-28129295b.xls
0
 
cyimxtckAuthor Commented:
Works perfectly!  Thanks so much!!!
0
 
Saqib Husain, SyedEngineerCommented:
You did not give any comment on the first code provided by me.
0
 
[ fanpages ]IT Services ConsultantCommented:
You are most welcome, B.

If you can, please offer ssaqibh some feedback too.

Thanks again.

BFN,

fp.
0
 
Saqib Husain, SyedEngineerCommented:
fp, do you see something that I am missing?
0
 
[ fanpages ]IT Services ConsultantCommented:
Other than you being ignored, no :)

To be fair, I have not tried your code.

Would you like me to?
0
 
Saqib Husain, SyedEngineerCommented:
Unless the OP comes back, I would appreciate it.
0
 
[ fanpages ]IT Services ConsultantCommented:
Hi,

Using your code...

If "ItemX" is used as a Category in the [ProductList] worksheet, only one matching row is returned within the [Output] worksheet (not two, as expected).

Also, if a Category that is not present in the [Values] worksheet is specified, for example, "ItemZZZ", then #N/A is displayed on the [Output] worksheet.

BFN,

fp.
0
 
Anthony MellorChartered AccountantCommented:
Nice to see we agree SQL does the trick.
0
 
Saqib Husain, SyedEngineerCommented:
Hi fp, Thanks for taking the trouble. I now see your point which I did not see in the question.

I tried your code and id generates NO output for ItemX.

Is that what is intended or am I missing something?
0
 
[ fanpages ]IT Services ConsultantCommented:
Hi,

You are very welcome.

Re: Are you missing something?

Did you save the workbook to a local drive (rather than running directly from your web browser cache)?

Also, if the file is marked with the "read only" attribute, adding an entry to the [ProductList] may not be noticed when the code runs (using the SQL IMEX method).

I would advise saving the file after a change is made to this worksheet & before clicking on the [Output] worksheet.
0
 
Saqib Husain, SyedEngineerCommented:
Sorry, fp

Yes you were right. I was doing it in readonly mode. It works when saved locally. I might have found a solution without SQL with shorter code but longer processing. I am miles away from SQL.

Once again thanks for taking the pain for me.

Saqib
0
 
[ fanpages ]IT Services ConsultantCommented:
You are very welcome, Saqib.

Yes, such an approach using Visual Basic for Applications [VBA]/ActiveX Data Objects [ADO]/SQL statements is longer to code than some methods (albeit, I acknowledge my code can probably be somewhat shorter without error handling & combining some of the coded lines into one), but ADO usage is faster (once the required objects have been created).

Implementation of a solution using ADO for such a problem as described above is not for everyone.  When pitching for a freelance contract around two years ago, I was set a practical technical examination in advance of a face-to-face meeting with the client.  One of the questions presented was of a similar nature as this question, & I provided a similar solution (in the form of a working prototype).

When sat with the client a few weeks later, they questioned my approach as it was something they had not seen previously.  Although they presented a much shorter piece of code to produce the same result, the speed of execution of my proposal was many magnitudes quicker than their "next best" solution.

PS. In case you have not seen the anthonymellorfca's article:

"Microsoft Excel SQL Versus VBA - an instance of Turing Completeness? A.K.A. Excel Rows to Sheets"

[ http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/A_11490-Microsoft-Excel-SQL-Versus-VBA-an-instance-of-Turing-Completeness-A-K-A-Excel-Rows-to-Sheets.html ]

The demonstrated use of Microsoft Query may be sufficient for many cases.

BFN,

fp.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

  • 9
  • 7
  • 4
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now