Populating ComboBox with dynamic values from another worksheet - vba

---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

Related

Ignore blanks in a range

Can some one help with the last bit of this code please, I have a range maximum ("A1:A54") when i set to this range and only (A1:A10) have a cell value which is the name of a sheet in another workbook.
This code is working but returns a
runtime 9 error
I really want to add if blank ignore if I change to range I have set to A1:A10 then no error. I think it might be there is no worksheets in the other workbook this is why I get an error on this loop.
Have looked how to ignore blanks but none of the answers i have found have worked.
I really want a if cell = "" then ignore currently I thought exit sub would work
Sub Iedextraction()
Dim wkb As Excel.Workbook, wkb1 As Excel.Workbook
Dim wks As Excel.Worksheet, wks1 As Excel.Worksheet
Dim cell As Range
Dim rng As Range
Workbooks.Open Filename:= _
"D:\Projects\ASE Templates\ASE Template White Book.xlsx"
Set wkb = Excel.Workbooks("ASE RTU Addressing with Automation.xlsm")
Set wks = wkb.Worksheets("Tab Names from White book")
Set wkb1 = Excel.Workbooks("ASE Template White Book.xlsx")
Set rng = wks.Range("A1:A54")
For Each cell In rng
wkb1.Sheets(cell.Value).Copy After:=Workbooks_
("ASE RTU Addressing with Automation.xlsm").Sheets(4)
If cell = "" Then Exit Sub
Next
' On Error GoTo 0
End Sub
Add conditional instruction:
If cl <> "" Then wkb1.Sheets(cell.Value).Copy After:=Workbooks _
("ASE RTU Addressing with Automation.xlsm").Sheets(4)
And remove:
If cell = "" Then Exit Sub
Your error occurs most probably because you try to copy before you do the check. So, at the end, you try to get a sheet with no name. :)
It is better practice to use dynamic ranges since it's likely going to change at some point in the future. There are multiple ways of doing this, but my go to method is something like this:
Dim rn As Range
Set rn = Range(Range("A1"), Range("A1").End(xlDown))
So your issue would be resolved (assuming the blank cells are truly empty) and you will not have to test for blank cells.
Regardless, you should mark one of the above answers are correct if they fixed your issue.

How can I copy a range of cells based on a Header to paste to another worksheet and match the headers?

I need a code to copy a range of cells (H21:H38) from my source worksheet (Acct Total) to a corresponding column on my target worksheet (COS% Tracking) based on matching headers. But the hiccup I have is that the header is in cell A6 on my source worksheet (Acct Total). I've researched it a bit and I've found this code that worked for someone else:
Sub CopyHeaders()
Dim header As Range, headers As Range
Set headers = Worksheets("ws1").Range("A1:Z1")
For Each header In headers
If GetHeaderColumn(header.Value) > 0 Then
Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("ws2").Cells(2, GetHeaderColumn(header.Value))
End If
Next
End Sub
Function GetHeaderColumn(header As String) As Integer
Dim headers As Range
Set headers = Worksheets("ws2").Range("A1:Z1")
GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)), Application.Match(header, headers, 0), 0)
End Function
So my issue is that I don't know where to begin to edit this code to work like I need. This code worked by using the header above the range of cells but that won't do in my case. I'll attach pictures so that hopefully I'm not too vague.
Can someone help me to edit this code according to my needs?
Edit: Additional Picture for the source of the dates.
GL Code Tab
Look at the following construct as a starting point for a different way to solve the same problem. There are descriptive variables so you have an idea of what is happening.
Edit: As the target sheet row 3 is locked, code has been amended to use Match function to return column number where string is found (if found).
Essentially:
Set your source and target worksheets.
Set sourceWorksheet = wb.Sheets("Acct Total")
Set targetWorksheet = wb.Sheets("COS% Tracking")
Define your target value (the date you are trying to match on) and source range
targetDate = Trim$(sourceWorksheet.Range("A6"))
Set sourceRange = sourceWorksheet.Range("H21:H38")
Find the column number of where value (targetDate) is present in the target sheet
colNum = Application.WorksheetFunction.Match(targetDate, searchRange, 0)
Add error handling in case it is not present i.e. if date (as string) is not found....
ErrHand: 'code in this section.....
Set the address of where the target data will be pasted
Set targetRange = .Range(Cells(4, colNum), Cells(21, colNum))
Set the target range to be equal to the source range.
targetRange.Value = sourceRange.Value
Adapt as appropriate.
Putting it together you getting something along the lines of the following:
Option Explicit
Public Sub copydata()
Dim sourceRange As Range
Dim targetDate As String
Dim targetRange As Range
Dim wb As Workbook
Dim sourceWorksheet As Worksheet
Dim targetWorksheet As Worksheet
Dim searchRange As Range
Set wb = ThisWorkbook
Set sourceWorksheet = wb.Sheets("Acct Total")
Set targetWorksheet = wb.Sheets("COS% Tracking")
targetDate = Trim$(sourceWorksheet.Range("A6"))
Set sourceRange = sourceWorksheet.Range("H21:H38")
Set searchRange = targetWorksheet.Rows(3)
On Error GoTo ErrHand
Dim colNum As Long
colNum = Application.WorksheetFunction.Match(targetDate, searchRange, 0)
With targetWorksheet
Set targetRange = .Range(Cells(4, colNum), Cells(21, colNum))
targetRange.Value = sourceRange.Value
End With
ErrHand:
If Err = 1004 Then
MsgBox "Not found: " & targetDate
Err.Clear
Exit Sub
End If
End Sub
See the following:
Finding address of text in worksheet
Moving data between sheets

Excel: Lookup table name excel for a given variable

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)

Match Index in VBA error

I am trying to use the Index and Match Worksheet Functions to match an item number from a combo box in a user form (ItemNum.value) to a product list table ("Product Pricing") on a worksheet. Then pull cells that match the same row from that worksheet ("Product Pricing") and copy them to cell ("i4") on an input data worksheet ("Review Lighting Data"). The problem is every time I run the macro it gives me the error "1004 Unable to get the Match Property of the WorksheetFunction class error"
My code is:
Private Sub InputLight_Click()
With Sheets("Review Lighting Data")
.Range("i4").Value = Application.WorksheetFunction.Index(Sheets("Product Pricing").Range("c7:c102"), Application.WorksheetFunction.Match(ItemNum.Value, Sheets("Product Pricing").Range("b7:b102"), 0))
End With
End Sub
I've since tried starting a new workbook to try to simplify things. Here is my complete code so far:
Private Sub inputbutton_Click()
Dim MatchRow As Long
Dim WS0 As Worksheet, WS1 As Worksheet
Dim R0 As Range, R1 As Range
With ThisWorkbook
Set WS0 = .Sheets("Review Lighting Data")
Set WS1 = .Sheets("Product Pricing")
End With
With WS1
Set R0 = WS1.Range("B7:B11")
Set R1 = WS1.Range("C7:C11")
End With
MatchRow = Application.Match(itemnum.Value, R0, 0)
MsgBox MatchRow
End Sub
Private Sub UserForm_Initialize()
With Me.itemnum
.AddItem "1001"
.AddItem "1002"
.AddItem "1003"
.AddItem "1004"
.AddItem "1005"
End With
End Sub
I've entered the item numbers into the combobox (itemnum) EXACTLY with no spaces or anything. I've even tried deleting the " marks around each number but that doesn't work either. I've tried outputting (MatchRow) into a MsgBox to try to catch the error but it breaks before it does.
The problem is that when Match doesn't found value in range, it returns error. You can handle this situation using IsError:
Private Sub InputLight_Click()
Dim matchRes
With Sheets("Review Lighting Data")
matchRes = Application.Match(ItemNum.Value, Sheets("Product Pricing").Range("b7:b102"), 0)
If Not IsError(matchRes) Then
.Range("i4").Value = Application.Index(Sheets("Product Pricing").Range("c7:c102"), matchRes)
End If
End With
End Sub
One good practice is to qualify everything properly. This makes the code easier to read and to debug. Also, you have to use Application.Match and not Application.WorksheetFunction....
Private Sub InputLight_Click()
Dim MatchRow
Dim WS0 As Worksheet, WS1 As Worksheet
Dim R0 As Range, R1 As Range
With ThisWorkbook
Set WS0 = .Sheets("Review Lighting Data")
Set WS1 = .Sheets("Product Pricing")
End With
With WS1
Set R0 = .Range("B7:B102")
Set R1 = .Range("C7:C102")
End With
MatchRow = Application.Match(ItemNum.Value, R0, 0)
If Not IsError(MatchRow) Then
WS0.Range("I4").Value = Application.Index(R1, MatchRow)
End If
End Sub
A very similar issue is found here: Match Not working Excel: Error 1004 Unable to get the Match Property, wherein #simoco and I also dealt with it similarly.
Okay after trying a bunch of different ways to get match index working within the userform I decided to 'cheat' a little and just used the regular match index function in the cells. Thank you all so much for your help!

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.