I have a UserForm with ComboBoxes 1-8 that each pick up text in designated cells in the ws upon UserForm_Activate. I have set ComboBoxes 2-8 to .Visible=False if ComboBox1.Value = "".
Is there a way to use an abbreviated code to set .Visible=False for each ComboBox without listing each one separately? I have added below what I'm using now, but I create forms like this often and would rather use a "Dim i as Integer / For i =" type thing instead that I could just copy and paste where needed. Thank you in advance!
If ComboBox1.Value = "" Then
ComboBox2.Visible = False
ComboBox3.Visible = False
ComboBox4.Visible = False
ComboBox5.Visible = False
ComboBox6.Visible = False
ComboBox7.Visible = False
ComboBox8.Visible = False
Indirect referencing of controls
Use indirect referencing via Controls() and try
Dim i As Long, current As Long
current = 1 ' << change to the combobox to be excepted
For i = 1 to 8 ' loop through all comboboxes
Me.Controls("ComboBox" & i).Visible = False
Next i
Me.Controls("ComboBox" & current).Visible = True
Related
this the code i have done until now , it works with one cell value and one photo only and it does not respect the cell height and width .
i want to make it works with multiple cells and images with respecting cells height and width
i hope someone can help
`Sub Auto_Insert_Photo()
Application.ScreenUpdating = False
Dim myObj
Dim Pictur
Set myObj = ActiveSheet.DrawingObjects
For Each Pictur In myObj
If Left(Pictur.Name, 7) = "Picture" Then
Pictur.Select
Pictur.Delete
End If
Next
Dim Asset As String, T As String
myDir = "D:\DOCUMENTATION\EQUIPMENT PHOTOS\AC BREAKERS\"
Asset = Range("A2")
T = ".png"
Range("C4").Value = EmployeeName
ActiveSheet.Shapes.AddPicture FileName:=myDir & Asset & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=190, Top:=10, Width:=120, Height:=120
Application.ScreenUpdating = True
End Sub`
I have a sheet with a number of pivot tables in Excel, which are controlled by one slicer to set a specific filter. I'm able to abstract the Slicer Items with a VBA function found on the internet:
Public Function GetSelectedSlicerItems(SlicerName As String) As String
Dim oSc As SlicerCache
Dim oSi As SlicerItem
Dim lCt As Long
On Error Resume Next
Application.Volatile
Set oSc = ThisWorkbook.SlicerCaches(SlicerName)
If Not oSc Is Nothing Then
For Each oSi In oSc.SlicerItems
If oSi.Selected Then
GetSelectedSlicerItems = GetSelectedSlicerItems & oSi.Name & ", "
lCt = lCt + 1
End If
Next
If Len(GetSelectedSlicerItems) > 0 Then
If lCt = oSc.SlicerItems.Count Then
GetSelectedSlicerItems = "All Items"
Else
GetSelectedSlicerItems = Left(GetSelectedSlicerItems, Len(GetSelectedSlicerItems) - 2)
End If
Else
GetSelectedSlicerItems = "No items selected"
End If
Else
GetSelectedSlicerItems = "No slicer with name '" & SlicerName & "' was found"
End If
End Function
Now, what I want to do, is to select the same Items in a different Slicer on another worksheet. So I've found another piece of code here on StackOverflow from #jeffreyweir, that works fine, as long as the array is hardcoded:
Sub Set_VfMSlicer()
Dim slr As Slicer
Dim sc As SlicerCache
Dim si As SlicerItem
Dim i As Long
Dim vItem As Variant
Dim vSelection As Variant
Set sc = ActiveWorkbook.SlicerCaches("Slicer_Afdeling")
'Set sc = slr.SlicerCache
vSelection = Array("DevOPs", "Functional Support", "Technical Support")
For Each pt In sc.PivotTables
pt.ManualUpdate = True 'Stops PivotTable from refreshing after each PivotItem is changed
Next pt
With sc
'At least one item must remain visible in the Slicer at all times, so make the first
'item visible, and at the end of the routine, check if it actually *should* be visible
.SlicerItems(1).Selected = True
'Hide any other items that aren't already hidden.
'Note that it is far quicker to check the status than to change it.
' So only hide each item if it isn't already hidden
For i = 2 To .SlicerItems.Count
If .SlicerItems(i).Selected Then .SlicerItems(i).Selected = False
Next i
'Make the PivotItems of interest visible
On Error Resume Next 'In case one of the items isn't found
For Each vItem In vSelection
.SlicerItems(vItem).Selected = True
Next vItem
On Error GoTo 0
'Hide the first PivotItem, unless it is one of the countries of interest
On Error Resume Next
If InStr(UCase(Join(vSelection, "|")), UCase(.SlicerItems(1).Name)) = 0 Then .SlicerItems(1).Selected = False
If Err.Number <> 0 Then
.ClearAllFilters
MsgBox Title:="No Items Found", Prompt:="None of the desired items was found in the Slicer, so I have cleared the filter"
End If
On Error GoTo 0
End With
For Each pt In sc.PivotTables
pt.ManualUpdate = False
Next pt
End Sub
I've tried to replace the vSelection = Array("DevOPs", "Functional Support", "Technical Support")
with: str = GetSelectedSlicerItems("Slicer_Afdeling1") vSelection = Split(str, ",")
which works, as long as only one item is selected in the source slicer. I want to be able to select multiple items as well. How can I fix this? The weird thing is that if a insert a msbBox in the loop to make the right items visible, it gives exactly the right items, which are also available in the slicer.
ps: the pivot tables are on different worksheets as well, but have the same range as source.
I'm having real trouble creating a string to use as the variable to copy differing tabs each time it's run depending on which cells are ticked.
My code cycles through a row of cells and anything with a tick (P) then adds to the array string.
The text generated in the string is identical to the hard coded equivalent but I get a runtime error 9 when I try to copy the tabs using the string.
The "rw" is populated in a previous macro that call this one.
My code is
public rw, col as long
public add as string
public add1 as variable
sub create_pack
Application.DisplayAlerts = False
Set wb1 = ActiveWorkbook
col1 = 8
add = ""
Do Until col1 > 17
If sh00.Cells(rw, col1) = "P" Then
If add = "" Then
add = """Pack " & col1 - 7 & """"
Else
add = add & ", ""Pack " & col1 - 7 & """"
End If
End If
col1 = col1 + 1
Loop
add1 = Array(add)
wb1.Sheets(add1).Copy
Set wb2 = ActiveWorkbook
Any help gratefully received as I'm completely stumped on this one.
Thank you.
I fixed it by copying tab by tab.
Hope this helps any subsequent viewers.
Sub create_pack()
Application.DisplayAlerts = False
Set wb1 = ActiveWorkbook
col = 8
Set wb1 = ActiveWorkbook
Set wb2 = Workbooks.add
wb1.Activate
Do Until col > 17
If sh00.Cells(rw, col) = "P" Then wb1.Sheets("Pack " & col - 7).Copy After:=wb2.Sheets(wb2.Sheets.Count)
col = col + 1
Loop
wb2.Activate
wb2.Sheets("Sheet1").Delete
wb2.Close False
wb1.Activate
End Sub
I am looking to iterate through an array and change the visibility of a userform checkbox based on the array index value i.e. if the checkbox caption is equal to the array index value, then the checkbox visibility is set accordingly. By defualt, the visibility of checkboxes is true, and I want to hide checkboxes whose caption value do not appear in an array. The problem I am having is that all the checkboxes are visible despite the conditions set. I have checked the values of all iteration variables and the array values, and all seems to be ok. I am concerned whether I am initialising the userform incorrectly or in the wrong location? Any help will be greatly appreciated.
With XrayFile
'populates array with values in variable worksheet range
Dim Xrayrange As Integer
lastpos = Sheets(Ship).Cells(Rows.Count, "A").End(xlUp).Row - 1
Xrayrange = lastpos - 6
'create array with variable dimensions based on worksheet range
ReDim X_ray_pos(Xrayrange) As String
Dim j As Integer
'iterate through worksheet range and set array index to cell value
For j = LBound(X_ray_pos) To UBound(X_ray_pos)
X_ray_pos(j) = Sheets(Ship).Range("A7").Offset(j).Value2
Next j
'userform1 is where the checkboxes are located. I chose to initialize the userform here thinking that it would matter for the iteration and change of the default state of the checkboxes
userform1.Show
userform1.Hide
Dim num As Variant
Dim i As Long
'iterates through checkboxes (named "CB1", "CB2" etc) and compares checkbox caption to array index value
For i = 0 To 55
Set c = Reject_list.Controls("CB" & i)
For Each num In X_ray_pos
If c.Caption Like num Then
c.Visible = True
Exit For
Else
c.Visible = False
End If
Next num
Next i
From this incorrect code:
For Each num In X_ray_pos
For i = 0 To 55
Set c = Reject_list.Controls("CB" & i)
If c.Caption Like num Then
c.Visible = True
Else
c.Visible = False
End If
Next i
Next num
To this solution:
For i = 0 To 55
Set c = Reject_list.Controls("CB" & i)
For Each num In X_ray_pos
If c.Caption Like num Then
c.Visible = True
Exit For
Else
c.Visible = False
End If
Next num
Next i
Hello again community,
After I got so much help from you with my last Problem, that promted me to rework the entire code in a more efficient manner, I would like to ask two more questions regarding the same Project.
(1) I would like to implement a live-filter in my listbox CGList1, which is connected to the textbox SearchCGList1. Whenever someone types in the textbox, the results in the listbox should be adjusted. I found this Article on your website, as well as this Article 3 on an external Webpage. However, due to my very limited skills, I have not been able to adapt it properly. More later.
(2) After multiple items from the same listbox CGList1 have been transferred to the second listbox CGList2 via a button (which works like a treat), I would like to save them in the same cell (Range "BM") on my Worksheet Meta DB. For this problem I also used Google extensively and tried to adapt the findings (see links below) for my code - without success.
I hope that the Patient ones amongst you can help me out once again, in the knowledge that I am trying to learn as much as possible. My Problem is that for a lot of things, I simply do not know what to look for.
My preliminary code for Problem 1:
CGList1 and CGList2 have no code. They are populated in the Userform_Initialize sub via:
'Fill Material Groups Listbox1 dynamically
Dim cell As Range
Dim rng As Range
With ThisWorkbook.Sheets("Commodity Groups")
'Range to 500 in order to allow for further additions
Set rng = .Range("A2", .Range("A500").End(xlUp))
End With
Me.CGList1.ColumnWidths = "20;80"
For Each cell In rng.Cells
'Filter out blanks
If cell <> "" Then
With Me.CGList1
.AddItem cell.value
.List(.ListCount - 1, 1) = cell.Offset(0, 1).value
End With
End If
Next cell
I cannot just use .AddItem and then filter through the columns like you find in many examples online because it needs to be dynamic and there are many blanks in between the selection items on the Worksheet.
The buttons:
Private Sub addCGbutton_Click()
For i = 0 To CGList1.ListCount - 1
If CGList1.Selected(i) = True Then
'Copy only CG Name, not respective number/letter combination (only more work to cut out when working with it later)
CGList2.AddItem CGList1.List(i, 1)
End If
Next i
End Sub
'Delete selected Commodity Groups from List 2 for re-selection
Private Sub delCGbutton_Click()
Dim counter As Integer
counter = 0
For i = 0 To CGList2.ListCount - 1
If CGList2.Selected(i - counter) Then
CGList2.RemoveItem (i - counter)
counter = counter + 1
End If
Next i
End Sub
After a lot of trial and failure trying to adapt the linked approaches from other people, I tried something more simple:
Private Sub SearchCGList1_Change()
'Only show with textbox matching items in CGList1 (filter)
Dim strSQL As String
strSQL = "SELECT fieldname FROM table WHERE fieldname = "
strSQL = strSQL & "'" & Me!SearchCGList1 & "*'"
strSQL = strSQL & " ORDER BY fieldname;"
Me!SearchCGList1.RowSource = strSQL
End Sub
But without success.
Regarding Problem 2:
To save the multiple selections from CGList2 in Range BM on Worksheet "Meta DB", I toyed around a lot and my last try was:
Save multiple selections from Commodity Group List 2 to the same cell in Excel
Dim listItems As String, c As Long
With CGList2
For c = 0 To .ListCount - 1
If .Selected(c) Then listItems = listItems & .List(c) & ", "
Next c
End With
Range("BM") = Left(listItems, Len(listItems) - 2)
Usually, all my other UserForm entries are saved with a single command button in the following fasion:
Private Sub CommandButton21_Click()
'Application.ScreenUpdating = False
'Define all relevant WBs we will be working with
Dim wbInput As Workbook
Dim wb As Workbook
Set wb = ActiveWorkbook
Dim ws As Worksheet
Set ws = wb.Worksheets("Meta DB")
Dim LastRow As Long
'Save Userform Inputs
With ws
.Activate
LastRow = ws.Range("A" & Rows.Count).End(xlUp).row + 1
.
.
Range("BK" & LastRow).value = Me.payinfo90
Range("BL" & LastRow).value = Me.payinfo90more
'Risk Management - Residual Information
Range("BM" & LastRow).value = Me.CGList2
Range("BN" & LastRow).value = Me.suppsince
.
.
End With
End Sub
Again, I thank everyone who took the time to read my post and answer with tips on what to improve.
Everyone have a great day.
Using a helper column with array formula.
So if say you had your data for the 1st list box in a1:a10 and the selection from this listbox is placed in D1, the 2nd complete listbox selections are in B1:B10, but not used, then in E1:E10, I have the following array formula filled down, so you would populate the 2nd listbox off the helper column E.
Beginning with
=INDEX($B$1:$B$10,SMALL(IF(LEFT($B$1:$B$10,LEN($D$1))=$D$1,ROW($B$1:$B$10),""),ROWS($E$1:$E1)),1)
Containing
=INDEX($B$1:$B$10,SMALL(IF(NOT(ISERR(SEARCH($D$1,$B$1:$B$10))),ROW($B$1:$B$10)),ROWS($E$1:E1)),1)
You need to press CTRL SHIFT and ENTER for array formula.