Excel: Lookup table name excel for a given variable - vba

I have one Workbook with multiple projects. Each project has it's own sheet. In each of these sheets there are columns for order numbers ("OrderNub").
In another sheet called "MasterList" contains all of the order numbers across all project. This list is in column A.
I need a function or Macro that will search all of my sheets (bar MasterList) and will display the sheet name in column B.
Below is what I have in Excel:
Option Explicit
Function FindMyOrderNumber(strOrder As String) As String
Dim ws As Worksheet
Dim rng As Range
For Each ws In Worksheets
If ws.CodeName <> "MasterList" Then
Set rng = Nothing
On Error Resume Next
FindMyOrderNumber = ws.Name
On Error GoTo 0
If Not rng Is Nothing Then
FindMyOrderNumber = ws.Range("A1").Value
Exit For
End If
End If
Next
Set rng = Nothing
Set ws = Nothing
End Function

Option Explicit
Function FindMyOrderNumber(strOrder As String) As String
Dim ws As Worksheet
Dim rng As Range
For Each ws In Worksheets
If ws.CodeName <> "MasterList" Then
Set rng = Nothing
On Error Resume Next
Set rng = ws.Columns(1).Find(strOrder)
On Error GoTo 0
If Not rng Is Nothing Then
FindMyOrderNumber = ws.Name
Exit For
End If
End If
Next
Set rng = Nothing
Set ws = Nothing
End Function
Assumptions:
Your project sheets us Table objects. If they don't, you need to edit line 11 to point to whatever range contains the OrderNub data.
If not tables, then your projects at least use the exact same layout. In that case, you could change line 11 to something like: Set rng = ws.Range("C1").EntireColumn.Find(strOrder)
The code name of the master list is MasterList. This is not the same as the worksheet name as seen on the tab. This is the VBA code name. I prefer to use that as it is less likely to be changed and break the check. You can find the codename in the VBA editor. For instance, in this screenshot, the codename for the first worksheet is shtAgingTable and the name - as shown on the tab in Excel - is AgingTable.
This is a function, not a subroutine. That means you don't run it once. It's meant to be used like any other built-in function like SUM, IF, whatever. For instance, you can use the following formula in cell B2:
=FindMyOrderNumber($A2)

Related

Populating ComboBox with dynamic values from another worksheet

---Update---
Thanks for the responses, I have found that DragonSamu's updated answer works perfectly.
---Original Post---
I have been trying to figure out where I am going wrong for the past few hours but I can't spot it. I think it's because the script is trying to draw the value from the active worksheet which is not what I want. Hopefully somebody can put me on the rite track - I think the answer should be relatively obvious but I just can't see it!
Basically, I am trying to populate a Combobox with a dynamic range of values that exist in another worksheet (but in the same workbook). I can get the Combobox to populate when I run the script in the worksheet 'Materials' (which is where the dynamic list is drawn from) but not when I run it in the worksheet 'Products'.
Unfortunately the script is designed to populate Products with Materials so is be run in a UserForm when the 'Products' worksheet is open and the 'Materials' worksheet would therefore be inactive.
I should also note that this script has been adapted from code I found elsewhere on this forum, so if it seems familiar I thank you in advance :)
Private Sub UserForm_Initialize()
Dim rRange As Range
On Error GoTo ErrorHandle
'We set our range = the cell B7 in Materials
Set rRange = Worksheets("Materials").Range("B7")
'Check if the cell is empty
If Len(rRange.Formula) = 0 Then
MsgBox "The list is empty"
GoTo BeforeExit
End If
'Finds the next empty row and expands rRange
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = Range(rRange, rRange.End(xlDown))
End If
'The range's address is our rowsource
Mat1_Name_ComBox.RowSource = rRange.Address
Mat2_Name_ComBox.RowSource = rRange.Address
Mat3_Name_ComBox.RowSource = rRange.Address
Mat4_Name_ComBox.RowSource = rRange.Address
Mat5_Name_ComBox.RowSource = rRange.Address
BeforeExit:
Set rRange = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description
Resume BeforeExit
End Sub
Any help is much appreciated.
Cheers,
Simon
From what I can see your code would be giving an error here:
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = Range(rRange, rRange.End(xlDown))
End If
Because your trying to set rRange by using Range() without defining the Worksheet first. This will get the Range from the ActiveWorksheet.
change it to the following:
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = Worksheets("Materials").Range(rRange, rRange.End(xlDown))
End If
best practice would be the following:
Private Sub UserForm_Initialize()
Dim wb as Workbook
Dim sh as Worksheet
Dim rRange As Range
On Error GoTo ErrorHandle
'Set the Workbook and Worksheet
set wb = Workbooks("products.xlsx")
set sh = wb.Worksheets("Materials")
'We set our range = the cell B7 in Materials
Set rRange = sh.Range("B7")
'Check if the cell is empty
If Len(rRange.Formula) = 0 Then
MsgBox "The list is empty"
GoTo BeforeExit
End If
'Finds the next empty row and expands rRange
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = sh.Range(rRange, rRange.End(xlDown))
End If
By properly defining and setting your Workbook and Worksheet you correctly reference to them and don't get errors.
Update:
the 2nd problem is that rRange.Address only places the Range location inside your .RowSource not the Sheet it needs to look at.
change:
Mat1_Name_ComBox.RowSource = rRange.Address
to:
dim strSheet as String
strSheet = "Materials"
Mat1_Name_ComBox.RowSource = strSheet + "!" + rRange.Address
This way it will include the Sheet name into the .RowSource

How to loop through range names and hide rows if cell = 0?

I have several VBA routines in an Excel 2007. There is a template worksheet which gets copied (and accordingly altered) up to 50 times. Now, this template contains a range called "HideRows", so this range gets copied several times in all those new worksheets. I want to hide all rows that contain the value 0 in the range "HideRows". Not all rows shall be hidden, only those rows that contain the value 0. This is what I've got so far:
Option Explicit
Sub HideEmptyRows()
Dim rngName As Range
Dim cell As Range
Application.ScreenUpdating = False
For Each rngName In ActiveWorkbook.Names
If rngName.Name = "HideRows" Then
With cell
For Each cell In rngName
If .Value = 0 Then
.EntireRow.Hidden = True
End If
Next cell
End With
End If
Next rngName
What's wrong here and what do I need to do to get it to work?
You can address the named range directly without looping. There is no test that this named range exists, as per your description it is safe to assume so.
Secondly, do not use the "with" statement outside of the loop that sets the referenced variable. Try this instead:
Option Explicit
Sub HideEmptyRows()
Dim rngName As Range
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In range("HideRows")
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
End If
Next cell
Application.ScreenUpdating = True
edit:
If the workbook contains multiple identical sheets where each sheet may contain this named range you will have to loop. This code will not loop over all names but over all sheets, and test for existance of the named range in each sheet:
Sub HideEmptyRows()
Dim sh As Sheets
Dim rng As Range, cell As Range
For Each sh In ActiveWorkbook.Sheets
Set rng = Nothing ' this is crucial!
On Error Resume Next
Set rng = sh.Names("HideRows")
On Error GoTo 0
If Not rng Is Nothing Then
For Each cell In rng
cell.EntireRow.Hidden = (cell.Value = 0)
Next cell
End If
Next sh
End Sub
The range variable has to be reset explicitly before the assignment as this step is skipped if the range does not exist. The following If would use the value last assigned then, which would be wrong.

Search Excel workbook tabs for all entries which match a criteria and produce a list?

I have large spreadsheet with over 20+ tabs. each tab has the same structure
A=ref,B= Discipline, C=Location, D=item/location, E=Defect, F=Date, G=%complete
What i want to do is get the search for G column throughout the entire workbook and return a list of all items which are not listed "100". The result would appear on the summary page.
Over time the list of items would become smaller as more 100 are entered in to the G column.
Could you advise on how I could do this?
Thanks
You can use the Range.Find method in VBA.
https://msdn.microsoft.com/en-us/library/office/ff839746.aspx
This assumes there'll always be something in column A and copies column A:G on to a sheet called Summary
Sub Find100Percent()
Dim wrkSht As Worksheet
Dim rFoundCell As Range
Dim sFirstAddress As String
Dim shtSummary As Worksheet
Set shtSummary = ThisWorkbook.Worksheets("Summary")
For Each wrkSht In ThisWorkbook.Worksheets
If wrkSht.Name <> shtSummary.Name Then
With wrkSht.Columns(7)
Set rFoundCell = .Find(1, LookIn:=xlValues)
If Not rFoundCell Is Nothing Then
sFirstAddress = rFoundCell.Address
Do
rFoundCell.Offset(, -6).Resize(, 7).Copy _
shtSummary.Cells(shtSummary.Rows.Count, 1).End(xlUp).Offset(1)
Set rFoundCell = .FindNext(rFoundCell)
Loop While Not rFoundCell Is Nothing And rFoundCell.Address <> sFirstAddress
End If
End With
End If
Next wrkSht
End Sub

how to create worksheets from a dynamic lis of values in vb

I have a list of values in a excel name range .I want to write a VB code so as to create worksheets using those list of values.These list of values keep on changing.
Here is the code:
Sub AddSheets()
Dim cell As Excel.Range
Dim wsWithSheetNames As Excel.Worksheet
Dim wbToAddSheetsTo As Excel.Workbook
Dim i As Integer
i = 0
Set wsWithSheetNames = ActiveSheet
Set wbToAddSheetsTo = ActiveWorkbook
For Each cell In wsWithSheetNames.Range("sheet_name").End(xlDown)
With wbToAddSheetsTo
.Sheets.Add after:=.Sheets(.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = cell.Value
If Err.Number = 1004 Then
Debug.Print cell.Value & " already used as a sheet name"
End If
On Error GoTo 0
End With
Next cell
Here sheet_name(cells in a single column) is the namerange where the name of the sheets to be created is dumped.
The no of sheets may change.
My above code does not work correctly , it just creates the a sheet with the sheet name of last value in this range.Where am i going wrong? I am new to VB.what may be a better way to do this?
This line:
For Each cell In wsWithSheetNames.Range("sheet_name").End(xlDown)
Get rid of the .End(xlDown), this is only grabbing the last value, as you said.
In naming the range, just using the name already has the entire range defined.
You are almost there. Notice the line below in your script, and just get rid of .End(xldown) at the end.
---For Each cell In wsWithSheetNames.Range("sheet_name").End(xlDown)-----
change to
---For Each cell In wsWithSheetNames.Range("sheet_name")-----
Then it will add the individual sheetname one after another.

VBA Select method errors

I am new to VBA and basically trying to write my first macro. It is meant to copy entries from one workbook to another omitting repeating values. I have the following code:
Dim s As String
Do While IsEmpty(ActiveCell) = False
If ActiveCell.Value <> s Then
s = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Windows("Main.xlsm").ActiveCell.Value = s
Windows("Main.xlsm").ActiveCell.Offset(1, 1).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
It gives me Runtime error 1004 for this line:
Windows("Main.xlsm").ActiveCell.Offset(1, 1).Select
Which means that method Select didn't work properly. (I have "Main.xlsm" opened but not active and a cell is selected.)
I searched similar questions and found that it may be because I haven't selected a sheet.
But somehow this line works:
Windows("Main.xlsm").ActiveCell.Value = s
And I can see that cell changed in workbook "Main.xlsm". So, I assume that Windows("Main.xlsm").ActiveCell does create a Range object.
Then why does the error happen? And what is the correct way to write this?
Also I tried changing my code to:
Windows("Main.xlsm").ActiveSheet.ActiveCell.Value = s
Windows("Main.xlsm").ActiveSheet.ActiveCell.Offset(1, 1).Select
Which gave me: "Runtime Error 438 Object doesn't support this property or method". Why is that? What's incorrect here?
And to:
Windows("Main.xlsm").Sheets("Name").ActiveCell.Value = s
Windows("Main.xlsm").Sheets("Name").ActiveCell.Offset(1, 1).Select
Which resulted the same way. And I still don't understand why two last don't work.
This is my first post here so if my editing or anything else is wrong please correct me.
Thanks!
Using ActiveCell, Select etc is not a good idea. Browse through SO Excel tag and you will find many answers advocating against it, many with good explanations why. For one of mine see this question
Instead, declare Range and Worksheet variables and assign these to your ranges and sheets
Dim wbSource as WorkBook
Dim wsSource as WorkSheet
Set wbSource = Application.Workbooks("Main.xlsm")
Set wsSource = wbSource.Worksheets("Name")
To use the workbook the VBA is in, use the ThisWorkbook object
If you want to start with the active sheet, it usuallu OK to use
Dim sh as Worksheet
Set sh = ActiveSheet
To work with a range, use something like
Dim rng as Range
' Set to a specific range
Set rng = Range sh.Range("A1:D10")
' or
With sh
Set rng = .Range(.Cells(1,1), .Cells(10,4))
End With
' Set to all used cells in a column
With sh
Set rng = .Range(.Cells(1,1), .Cells(.Rows.Count,1).End(xlUp))
End With
' Adjust rng
Set rng = rng.Offset(1,0)
Set rng = rng.Resize(10,1)
So, to refactor your code fragment
Dim s As String
Dim rng as Range, cl as Range
Dim shSource as Worksheet
Dim rngDestination as Range
Set shSource = Application.Workbooks("Main.xlsm").Worksheets("SheetName")
Set rngDestination = shSource.Range("A1") ' Change to whatever you need here
Set rng = ActiveCell ' if you must!
' Just in case only one cell entry exists, avoid selecting down to bottom of sheet
If Not IsEmpty(rng.Offset(1,0)) Then
Set rng = Range(rng, rng.End(xlDown)) ' unqualified Range (ie no sh. part) refers to the active sheet
End IF
For Each cl In rng
If cl.Value <> s Then
s = cl.Value
rngDestination.Value = s
Set rngDestination = rngDestination.Offset(1, 1) ' should this be .Offset(1, 0) ?
End If
Next