My Word userform combobox load items from Excel file, and the items shown fine,
I need help with searching code in combobox change event
the searching code running fine in Excel, I think Word not support application.match
any help..
Dim i As Long
Dim d As Object
With Me.ComboBox1
Set d = CreateObject("scripting.dictionary")
d.CompareMode = vbTextCompare
If Len(.Text) And IsError(Application.Match(.Text, va, 0)) Then
For i = 1 To UBound(va)
If InStr(1, " " & va(i), " " & .Text, vbTextCompare) Then d(va(i)) = Empty
Next
.List = d.keys
.DropDown
ElseIf Len(.Text) = 0 Then
.List = va
End If
End With
Crossed post
LINK
Related
I'm trying to make a grid of Option Buttons from about 10x60 and would like to do so with VBA, but I can't get the attribute changing to work.
So far I got this:
Sub Buttons()
Dim i As Integer
Dim j As Integer
Dim k As Integer
k = 48
For i = 8 To 9
For j = 5 To 15
ActiveSheet.Shapes.Range(Array("OptionButton" & k)).Select
k = k + 1
Selection.Copy
With Sheets("Weekreview")
.Cells(i, j).Select
.Paste
.Shapes.Range(Array("OptionButton" & k)).Select
.OptionButtons(k).GroupName = i - 1
.OptionButtons(k).LinkedCell = Range(j, i)
End With
Next
Next
End Sub
The problem with this is that the program errors at .OptionButtons(k).GroupName with the message "Unable to get the OptionButtons property of the Worksheet class".
Anyone who can help me?
Edit 1: My first try (before I tried pretty much all the ways I could find googling the issue) was to use Selection.GroupName, this didn't work either. It looks like it can't access the attributes. So either the attribute changing is wrong, or the selection is wrong.
Edit 2: I got the entire program working except the changing of the GroupName of an existing OptionButton. Even though Selection.LinkedCell works, Selection.GroupName doesnt.
Your code copy and paste OptionButton & k then refers to OptionButton & k+1 (object doesn't exist).
Look at line were k is incremented:
k = k + 1
Please change all the words
ActiveSheet.Shapes.Range(Array("OptionButton" & k))
to
ActiveSheet.Shapes.Range("Option Button " & k)
Please try this code:
Sub Buttons()
Dim i As Integer
Dim j As Integer
Dim k As Integer
k = 48
For i = 8 To 9
For j = 5 To 15
ActiveSheet.Shapes.Range(Array("OptionButton" & k)).Select
k = k + 1
Selection.Copy
ActiveSheet.Paste
With Selection
.Name = "OptionButton" & k
.Top = Worksheets("Weekreview").Cells(i, j).Top
.Left = Worksheets("Weekreview").Cells(i, j).Left
.GroupName = i - 1
.LinkedCell = Range(j, i)
End With
Next
Next
End Sub
Controls with a naming convention of TypeName# are ActiveX controls (e.g. "OptionButton1","TextBox1"). The object itself is wrapped in an OLEObject. ActiveX controls on a Worksheet should be references using the Worksheet's OLEObjects collection.
Properties not available directly from the OLEObject can be access by the OLEObject.Object.
Sub Buttons()
Application.ScreenUpdating = False
Dim opt As OLEObject
Dim cell As Range
With Sheets("Weekreview")
For Each cell In Range(Cells(8, 5), Cells(9, 15))
Set opt = .OLEObjects.Add(ClassType:="Forms.OptionButton.1", Link:=False, DisplayAsIcon:=False, Width:=108, Height:=21)
With opt
.Left = cell.Left
.Top = cell.Top
.Width = cell.Width
.LinkedCell = cell
.Name = cell.Address(False, False)
With opt.Object
.GroupName = cell.Row
.Caption = cell.Address(False, False)
End With
End With
Next
End With
Application.ScreenUpdating = True
End Sub
I'm trying to create an array of option buttons (or check boxes if you find that works better) where only one option can be selected in each row and column.
I'm trying to do this so that a user can choose an order in which a certain list goes.
The following code takes the column headers in an excel sheet, and creates bunch of option buttons x columns across and x rows down.
Sub Option_Buttons()
Dim str As String
lCol = Sheets("Headers").UsedRange.Columns.Count
Dim OpBtn() As OptionButton
ReDim OpBtn(lCol, lCol) As OptionButton
Dim GrBx() As GroupBox
ReDim GrBx(lCol) As GroupBox
Dim i
Dim j
'
For i = 1 To lCol
Set GrBx(i) = Sheets("OPBTN").GroupBoxes.Add(Cells(i, 1).Left, _
Cells(i, 1).Top, lCol * 50, 17.25)
With GrBx(i)
.Caption = ""
'.Visible = False
End With
For j = 1 To lCol
Set OpBtn(i, j) = Sheets("OPBTN").OptionButtons.Add _
(Cells(i,j).Left, Cells(i, j).Top, 72, 17.25)
str = Sheets("Turf").Cells(1, j)
check = OpBtn(i, j).Value
With OpBtn(i, j)
.Caption = str
.Value = xlOff '
.LinkedCell = "'OData'!" & Sheets("OData").Cells(i, 1).Address
.Display3DShading = False
End With
Next
Next
End Sub
Is there any way I can make it so that only one option can exist in each row AND column? (so if there are 5 column headers, there are 25 option buttons of which only 5 can be selected).
Is there any way to deal with the option that a user doesn't want a header selected?
I'm trying to avoid all possible uses of the controls tab because this is part of a macro that needs to be used by completely excel illiterate people and needs to be applied to highly variable
I was able to accomplish this using checkboxes. The key was to name the checkboxes using R1C1 notation and assigning a macro (ManageCheckBoxes) to all the checkboxes. After identifying what checkbox was clicked using Application.Caller I iterate over all the checkboxes parsing their names to identify which rows and columns they are in.
Sub Option_Buttons()
Dim str As String
Dim r As Integer, c As Integer
Dim check As CheckBox
lCol = Sheets("Headers").UsedRange.Columns.Count
With Sheets("OPBTN")
For r = 1 To lCol
For c = 1 To lCol
Set check = .CheckBoxes.Add(.Cells(r, c).Left, .Cells(r, c).Top, 72, 17.25)
str = Sheets("Turf").Cells(r, c)
With check
.Caption = str
.Value = xlOff '
.Name = "R" & r & "C" & c
.Display3DShading = False
.OnAction = "ManageCheckBoxes"
End With
Next
Next
End With
End Sub
Sub ManageCheckBoxes()
Dim arrCaller As Variant, arrCheck As Variant
Dim check As CheckBox, ckCaller As CheckBox
arrCaller = getRC(Application.Caller)
With Sheets("OPBTN")
Set ckCaller = .CheckBoxes(Application.Caller)
For Each check In .CheckBoxes
If ckCaller.Name <> check.Name Then
If check.Name Like "R#*C#*" Then
arrCheck = getRC(check.Name)
If arrCheck(0) = arrCaller(0) Or arrCheck(1) = arrCaller(1) Then
check.Value = False
End If
End If
End If
Next
End With
End Sub
Function getRC(sName As String)
Dim a(1) As Long
Dim arr As Variant
arr = Split(sName, "C")
a(0) = Right(arr(0), Len(arr(0)) - 1)
a(1) = arr(1)
getRC = a
End Function
use GroupName property of option buttons. GroupName property determines the group of option button. user will be able to select only one option button from the group.
Set same groupname for your five option buttons and same for other five.
For Example :
Option1 GroupName: grp1
Option2 GroupName: grp1
Option3 GroupName: grp2
Option4 GroupName: grp2
in the above case user will be able to select one from option1 and option2. one button from option3 and option4.
First off, ill give credit where credit is due. This is put together using code from u/Joe Was from Mr.Excel.com and exceltip.com.
Now that I have gotten that out of the way I am trying to create a search function that will search through my 9 sheet document in excel, to find a value that was typed into a search box. Then paste those values onto the first page of the workbook.
What do I need to change in my code to make it paste to the right place on the search page? I have tried changing things in the last loop because that is where I get the "Run-Time error 91. Object variable or with block variable not set".
I've googled that error, but variables always screw me up so that may be the problem.
The search page.
This is where the Debugger stops.
This is my code so far.
Sub Find_one()
'Find Function For ERF Spreadsheet'
'Type in Box, Press Button, Display the Results'
Dim ws As Worksheet, Found As Range
Dim myText As String, FirstAddress As String
Dim AddressStr As String, foundNum As Integer
myText = Range("D5")
If myText = "" Then Exit Sub
For Each ws In ThisWorkbook.Worksheets
With ws
'Do not search sheet1'
If ws.Name = "Sheet1" Then GoTo myNext
Set Found = .UsedRange.Find(What:=myText, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not Found Is Nothing Then
FirstAddress = Found.Address
Do
foundNum = foundNum + 1
AddressStr = AddressStr & .Name & " " & Found.Address & vbCrLf
Set Found = .UsedRange.FindNext(Found)
'Found.EntireRow.Copy _
'Destination:=Worksheets("Sheet4").Range("A65536").End(xlUp).Offset(1, 0)
Loop While Not Found Is Nothing And Found.Address <> FirstAddress
End If
myNext:
End With
Next ws
If Len(AddressStr) Then
Sheet8.Range("B18") = ws.Cells(x, 1)
Sheet8.Range("C18") = ws.Cells(x, 2)
Sheet8.Range("D18") = ws.Cells(x, 3)
Sheet8.Range("E18") = ws.Cells(x, 4)
Sheet8.Range("F18") = ws.Cells(x, 5)
Sheet8.Range("G18") = ws.Cells(x, 6)
Sheet8.Range("H18") = ws.Cells(x, 7)
Sheet8.Range("I18") = ws.Cells(x, 8)
Sheet8.Range("J18") = ws.Cells(x, 9)
Else:
MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
End Sub
This is the original code for the last loop...
If Len(AddressStr) Then
MsgBox "Found: """ & myText & """ " & foundNum & " times." & vbCr & _
AddressStr, vbOKOnly, myText & " found in these cells"
Else:
MsgBox "Unable to find " & myText & " in this workbook.", vbExclamation
End If
Here, try this out. I redid how I interpreted the first section. I'm not entirely sure what you're trying to do with everything so let me know if this works or where it went wrong.
Sub FindOne()
Dim k As Integer
Dim myText As String, searchColumn As String
Dim totalValues As Long
Dim nextCell As Range
k = ThisWorkbook.Worksheets.Count
myText = Sheets(1).Range("D5").Value
If myText = "" Then
MsgBox "No Address Found"
Exit Sub
End If
Select Case ComboBox1.Value
Case "Equipment Number"
searchColumn = "A"
Case "Sequence Number"
searchColumn = "B"
Case "Repair Order Number(s)"
searchColumn = "D"
Else
MsgBox "Please select a value for what you are searching by."
End Sub
End Select
For i = 2 To k
totalValues = Sheets(i).Range("A65536").End(xlUp).Row
ReDim AddressArray(totalValues) As String
For j = 0 To totalValues
AddressArray(j) = Sheets(i).Range(searchColumn & j + 1).Value
Next j
For j = 0 To totalValues
If (InStr(1, AddressArray(j), myText) > 0) Then
Set nextCell = Sheets(1).Range("A65536").End(xlUp).Offset(1, 0)
Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(i).Range("A" & j, "I" & j).Value
End If
Next j
Next i
End Sub
Also I have no clue what that second part of the code is supposed to be, so if you want to elaborate on the section with If Len(AddressStr) Then, I'd appreciate it because that really doesn't even work as an If...Then statement lol :)
Been trying to find a way to populate a combobox by reading a range and only choosing the cells that have some value.
I have some code that creates a button every row at column S to open a user form with a combobox.
in column "H" from row 5 down, I have cells filled with colors (text)
My objective is that the itemlist of the combobox shows by default not the 1st item from the range (starting at H5) but the corresponding item from each cell
Here's my piece of code for populating the combobox1:
Sub testingcombo()
Dim c As Range
Dim index As Integer
ComboBox1.Clear
index = ComboBox1.ListIndex
With Worksheets("sheet1")
For Each c In .Range(.Range("H5"), .Range("H" & .Rows.Count).End(xlUp))
If c.Value <> vbNullString Then ComboBox1.AddItem c.Value
Next c
End With
Me.ComboBox1.ListIndex = 0 '(this only chooses by default the 1st entry of the range)
Thks,
Edgar
In the code associated with the buttons, write this (not my code. Look here):
Public rs As Integer
Sub MyButton()
Dim b As Object
Dim cs As Integer
Dim ss, ssv As String
Set b = ActiveSheet.Buttons(Application.Caller)
With b.TopLeftCell
rs = .Row
cs = .Column
End With
ss = Left(Cells(1, cs).Address(False, False), 1 - (ColNumber > 26)) & rs
ssv = Range(ss).Value
'MsgBox "Row Number " & rs & " Column Number " & cs & vbNewLine & _
'"Cell " & ss & " Content " & ssv
UserForm1.Show
End Sub
And then in the UserForm this:
Public Sub UserForm_Initialize()
Dim c As Range
Dim index As Integer
ComboBox1.Clear
index = ComboBox1.ListIndex
With Worksheets("sheet1")
For Each c In .Range(.Range("H5"), .Range("H" & .Rows.Count).End(xlUp))
If c.Value <> vbNullString Then ComboBox1.AddItem c.Value
Next c
End With
Me.ComboBox1.ListIndex = rs - 5
End Sub
I have a Combo Box (GSMListType) with different variables "A", "A - K", "B", "C", etc... linked to a List Box (AvailableNumberList) which calls on cells from different sheets based on the selection in the Combo Box.
The Combo Box has 32 different variables which call on 32 different sheets. Below is a sample of the code.
"A" collects the data in sheet A_Regular and adds its items into the List Box
"A - K" collects the data in sheet A_K and adds its items into the List Box
"B" collects the data in sheet B_Regular and adds its items into the List Box
"C" collects the data in sheet C_Regular and adds its items into the List Box
and so on...
Is there a way to simplify the below mentioned code? The sheet is fully functional, but the code is a mess.
Private Sub GSMListType_Change()
Dim TypeLookup As Double
'If listing has changed, clear AvailableNumberList and insert new data
If GSMListType.ListIndex > -1 Then
AvailableNumberList.Clear
If GSMListType.Value = "A" Then
TypeLookup = Application.WorksheetFunction.CountIf(A_Regular.Range("A:E"), GSMListType.Value)
With AvailableNumberList
For k = 2 To TypeLookup + 1
.AddItem A_Regular.Range("A" & k).Value
Next k
End With
ElseIf GSMListType.Value = "A - K" Then
TypeLookup = Application.WorksheetFunction.CountIf(A_K.Range("A:E"), GSMListType.Value)
With AvailableNumberList
For k = 2 To TypeLookup + 1
.AddItem A_K.Range("A" & k).Value
Next k
End With
ElseIf GSMListType.Value = "B" Then
TypeLookup = Application.WorksheetFunction.CountIf(B_Regular.Range("A:E"), GSMListType.Value)
With AvailableNumberList
For k = 2 To TypeLookup + 1
.AddItem B_Regular.Range("A" & k).Value
Next k
End With
ElseIf GSMListType.Value = "C" Then
TypeLookup = Application.WorksheetFunction.CountIf(C_Regular.Range("A:E"), GSMListType.Value)
With AvailableNumberList
For k = 2 To TypeLookup + 1
.AddItem C_Regular.Range("A" & k).Value
Next k
.
.
.
End With
End If
End If
End Sub
I don't think this improves your original code sample by any substantial measure but it does tidy things up by reducing the repetitious sections.
Private Sub GSMListType_Change()
Dim TypeLookup As Long, ws As Worksheet
'If listing has changed, clear AvailableNumberList and insert new data
If GSMListType.ListIndex > -1 Then
With GSMListType
Select Case .Value
Case "A"
Set ws = A_Regular 'Sheets("A_Regular") ?????
Case "A - K"
Set ws = A_K
Case "B"
Set ws = B_Regular
Case "C"
Set ws = C_Regular
Case Else
'do nothing
End Select
TypeLookup = Application.CountIf(ws.Range("A:E"), .Value)
End With
With AvailableNumberList
.Clear
For k = 2 To TypeLookup + 1
.AddItem ws.Range("A" & k).Value
Next k
End With
End If
Set ws = Nothing
End Sub
I wasn't sure about your worksheet designation method to some module-wide variable pointing to the various worksheets so I includes a commented alternative that uses the worksheet name(s).