Sub ShowUserForm1()
''Check where the last row is on column B
'' The counter removes one because the first cell is "Topic"
counter = Cells(Rows.Count, 4).End(xlUp).Row
While (Range("D" & counter).Value) = ""
counter = counter - 1
Wend
'' Loop through all the objects in the userform
'' In this example, it's important that the label and textbox will be names Label# / TextBox# because it removes 5 or 7 strings to extract the object number
'' Check the number of the object, and if it's higher than the counter, hides it
For Each formObject In UserForm1.Controls
If TypeName(formObject) = "Label" Then
If Left(formObject.Caption, 5) = "Label" Then
objectNumber = Right(formObject.Name, Len(formObject.Name) - 5)
'Change the label caption according to the cell value
formObject.Caption = Cells(CInt(objectNumber) + 1, 4).Value
If CInt(objectNumber) > counter Then formObject.Visible = False
End If
End If
If TypeName(formObject) = "TextBox" Then
objectNumber = Right(formObject.Name, Len(formObject.Name) - 7)
If objectNumber > 12 Then objectNumber = objectNumber - 12
If CInt(objectNumber) > counter - 1 Then formObject.Visible = False
End If
Next
If counter < 5 Then
'' Change the userform height, you can play with the numbers
UserForm1.Height = 70 + 40 * counter
' Move the button up higher
UserForm1.CommandButton1.Top = 40 + 43 * counter - 60
ElseIf counter < 13 Then
'' Change the userform height, you can play with the numbers
UserForm1.Height = 70 + 35 * counter
' Move the button up higher
UserForm1.CommandButton1.Top = 40 + 35 * counter - 60
ElseIf counter > 13 Then
'' Change the userform height, you can play with the numbers
UserForm1.Height = 70 + 50 * counter
' Move the button up higher
UserForm1.CommandButton1.Top = 40 + 53 * counter - 60
End If
UserForm1.Show
End Sub
My counter starts and only counts with active sheet, is there a way I can convert this to count the same data, but just on a different worksheet?
Active sheet is sheet2, but to have the counter count on sheet1 (inactive)
Thanks in advance!
Edit: Adding full code
Try,
Sub test()
Dim Ws As Worksheet
Dim counter As Long
Set Ws = Sheet1
With Ws
.Visible = xlSheetVisible
counter = .Cells(Rows.Count, 4).End(xlUp).Row
.Visible = xlSheetVeryHidden '<~~ you can't set visibility on the sheet
'.Visible = xlSheetHidden '<~~ you can set visibility on the sheet
End With
Stop
End Sub
Related
For the first 15 ranks, I want to manually enter the values in B2:P11. For ranks 16 to 30, I want to randomize these values using an Excel VBA button, with the following code:
Sub rand_group()
Dim i As Long
Dim j As Long
Dim myFlag(1 To num_man)
Dim s_group As Worksheet
Set s_group = Worksheets("group")
'óêêîånóÒÇèâä˙âª
Randomize
s_group.Cells.Clear
s_group.Range("A1") = "group_id"
For i = 1 To num_group
s_group.Cells(i + 1, 1) = i
Next i
For i = 1 To num_man
s_group.Cells(1, i + 1) = "m_rank" & i
Next i
For i = 1 To num_group
For j = 16 To num_man
myFlag(j) = False
Next j
For j = 16 To num_man
Do
'óêêî=Int((ç≈ëÂíl - ç≈è¨íl +1 ) * Rnd + ç≈è¨íl)
myNum = Int((num_man - 1 + 1) * Rnd + 1)
Loop Until myFlag(myNum) = False
s_group.Cells(i + 1, j + 1).Value = myNum
myFlag(myNum) = True
Next j
Next i
End Sub
However, these random values should neglect the manually entered values in B2:P11
How can I change the code to fix this?
Screenshot of the excel file is displayed below:
I want to manually fill values from B2 to P11
Thank you in advance for your response!
Michiel
To fill in the random section of the grid, the myFlag array is not needed. Just use the cell coordinates to set the random values. Also remove the Clear call since that clears the entire sheet.
To prevent duplicate numbers in a row, use the excel CountIf function in a loop until a unique random number is found.
Here is the updated code. It can be run multiple times without affecting the manual data.
Sub DoRand()
Dim i As Long
Dim j As Long
Dim s_group As Worksheet
Set s_group = Worksheets("group")
num_group = 10
num_man = 30
Randomize
's_group.Cells.Clear ' clear sheet
' build table
For i = 1 To num_group ' group id
s_group.Cells(i + 1, 1) = i
Next i
For i = 1 To num_man ' column names
s_group.Cells(1, i + 1) = "m_rank" & i
Next i
' fill in random numbers
For i = 1 To num_group 'row
For j = 16 To num_man 'column
Do While True
n = Int((num_man) * Rnd + 1) ' get random number
cnt = Application.WorksheetFunction.CountIf(Range(s_group.Cells(i + 1, 2), s_group.Cells(i + 1, j)), "=" & n) ' check if number in row
s_group.Cells(i + 1, j + 1).Value = n ' set cell value
If cnt = 0 Then Exit Do ' if unique in row, go to next cell
Loop ' not unique, try new random value
Next
Next
End Sub
I've got a button that creates checkboxes. If I press it again I want to delete the previous checkboxes made and replace them with new ones. This is the code for the delete and create new part:
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Type = 12 Then
If Not Intersect(s.TopLeftCell, Sheets("EmpChoice").Range("A14:T33")) Is Nothing Then
s.Delete
End If
End If
Next
Dim obj As Object
Dim rng As Range
For i = 1 To EmployeeNo
If i > 6 And i < 13 Then 'Just code that spaces the checkboxes out evenly
col = 3
offset = 12
ElseIf i >= 13 Then
col = 5
offset = 24
Else
col = 1
offset = 0
End If
Set rng = Sheets("EmpChoice").Cells(14 + (i * 2) - offset, col)
cellLeft = rng.Left
cellTop = rng.Top
cellwidth = rng.Width
cellheight = rng.Height
Set obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Checkbox.1", Left:=cellLeft, Top:=cellTop, Width:=cellwidth * 2, Height:=cellheight * 2)
ActiveSheet.OLEObjects("CheckBox" & i).Object.Caption = EmployeeList(i)
Next i
The problem is that if the code creates 18 checkboxes and then deletes them, the new ones starts with the name "CheckBox19", crashing the code. Is it possible to make sure that the new checkboxes starts at "CheckBox1"?
Trying inserting of the obj name, like in the next piece of code:
Set obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Checkbox.1", Left:=cellLeft, Top:=cellTop, Width:=cellwidth * 2, Height:=cellheight * 2)
obj.Name = "CheckBox" & i 'Here you can choose the name you need...
'Otherwise, VBA keeps track of the previous created objects
ActiveSheet.OLEObjects("CheckBox" & i).Object.Caption = EmployeeList(i)
Here is my loop that checks which boxes have true values and assigns their tag names into a string (fund1, fund2, fund3):
counter = 0
Dim ctrl As MSForms.Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl.Value = True Then
counter = counter + 1
If counter = 1 Then
fund1 = ctrl.Tag
ElseIf counter = 2 Then
fund2 = ctrl.Tag
ElseIf counter = 3 Then
fund3 = ctrl.Tag
End If
End If
End If
Next ctrl
The code works fine however say i have 5 check boxes with tags and names a through e. I want to set an order of importance for which checkboxes get looped through first. Currently, for example:
fund 1 = c.tag
fund 2 = a.tag
fund 3 = b.tag
But I would want:
fund 1 = d.tag
fund 2 = b.tag
fund 3 = c.tag
How to I prioritize certain check boxes to be looped through first?
I tried changing the TabIndexes in each checkbox's properties and was unsuccessful.
Thanks in advance
If you are talking about a priority across checkboxes, I guess you already know them and you don't discover them at run-time.
In that case, just create your own collection (which you sort the way you want), declare it on top of the module (so that the variable remains global and accessible all over the execution of your program) and populate it once at initialization.
For example:
Public prioritizedCheckboxes As Collection '<-- on top of the form module (global variable)
'--------------------------------------------
Private Sub initializePrioritizedList()
Set prioritizedCheckboxes = New Collection
With prioritizedCheckboxes
.Add d '<-- most important
.Add c '<-- second most important
'...
.Add b '<-- less important
End With
End Sub
'--------------------------------------------
Private Sub UserForm_Initialize()
initializePrioritizedList '<-- initialize your list when you initialize the form (or whenever you prefer)
End Sub
'--------------------------------------------
... and then use your code with the priorized collection:
counter = 0
Dim ctrl As MSForms.Control
For Each ctrl In prioritizedCheckboxes '<-- you sorted the list. So you know first you'll have d, then c, then a etc.
If ctrl.Value = True Then
counter = counter + 1
If counter = 1 Then
fund1 = ctrl.Tag
ElseIf counter = 2 Then
fund2 = ctrl.Tag
ElseIf counter = 3 Then
fund3 = ctrl.Tag
End If
End If
Next ctrl
You could name your check boxes to reflect their priority (e.g.: "myCB1", "myCB2", etc...) and the directly get them via Controls collection:
Dim iCB As Long, counter As Long
Dim fund1 As String, fund2 As String, fund3 As String
With Me
For iCB = 1 To 5
With .Controls("myCB" & iCB)
If .Value Then
counter = counter + 1
If counter = 1 Then
fund1 = .Tag
ElseIf counter = 2 Then
fund2 = .Tag
ElseIf counter = 3 Then
fund3 = .Tag
End If
End If
End With
Next
End With
Moreover, a Select Case structure could be more readable:
Dim iCB As Long, counter As Long
Dim fund1 As String, fund2 As String, fund3 As String
With Me
For iCB = 1 To 5
With .Controls("myCB" & iCB)
If .Value Then
counter = counter + 1
Select Case counter
Case 1
fund1 = .Tag
Case 2
fund2 = .Tag
Case 3
fund3 = .Tag
End Select
End If
End With
Next
End With
Finally you could consider using an array instead of three variables:
Dim iCB As Long, counter As Long
Dim funds(1 To 3) As String
With Me
For iCB = 1 To 3
With .Controls("myCB" & iCB)
If .Value Then
counter = counter + 1
funds(counter) = .Tag
End If
End With
Next
End With
and then access them with funds(1), funds(2) and funds(3)
I have been battling with this code for several days now and would appreciate some guidance on where I am going wrong.
My project is to create a printable document format containing manufacturing instructions and spaces for operators to write manual entries, which requires a minimum cell size when printed onto A4. These instructions will be varied but in all cases will be signed in column B, and in some cases will be countersigned. The marker in column B for a signature is "Op" and the marker for a countersignature is "Check".
In order to regulate cell size for the printed document I am attempting to count row heights up until a fixed total (832), from that point I want the code to go up and look for the first "Op", if the "Op" has a "Check" in the cell below then insert a page break below "Check", if not then insert a page break below "Op". From there I want the code to continue to the bottom of the document inserting page breaks every time it counts 832 total rows.
I am not sure if that methodology is the best for achieving what I am aiming for but would appreciate some feedback on what I have so far, I am getting an run time error 1004 on this code and it is inserting page breaks in the wrong places.
Sub TotalHeight()
Dim HowTall As Long
Dim Count As Long
Dim TotalHeight As Long
HowTall = 0
Count = 0
TotalHeight = 0
Dim cell As Range
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'If Not cell.Hidden Then
HowTall = HowTall + cell.RowHeight
'Count = Count + 1
If HowTall > 832 Then
Debug.Print cell.Row
For tmpcounter = 0 To 100
' If (Range(cell.Row).Offset(-tmpcounter, 0).Value) = "Op" Then
If cell.Offset(-tmpcounter, 0).Value = "Op" Then
If cell.Offset(-tmpcounter + 1, 0).Value = "Check" Then
'Found Check - get current row
PageBreakRowNo = cell.Offset(-tmpcounter + 1, 0).Row
Debug.Print "Check found at row " & PageBreakRowNo
Sheets("Dispensary").HPageBreaks.Add Before:=cell.Offset(-tmpcounter + 2, 0)
Else
'Only found Op - Get current row
PageBreakRowNo = cell.Offset(-tmpcounter, 0).Row
Debug.Print "Op found at row " & PageBreakRowNo
Sheets("Dispensary").HPageBreaks.Add Before:=cell.Offset(-tmpcounter + 1, 0)
End If
End If
Next tmpcounter
End If ' end of of HowTall >832 loop
Next 'end of for each cell in Column B loop
End Sub
Added my suggested improvements in your original code:
Sub TotalHeight()
Dim HowTall As Long
Dim Count As Long
Dim TotalHeight As Long
Dim tmpcounter1 As Long
HowTall = 0
Count = 0
TotalHeight = 0
Dim cell As Range
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'If Not cell.Hidden Then
HowTall = HowTall + cell.RowHeight
'Count = Count + 1
If HowTall > 832 Then
Debug.Print cell.Row
For tmpcounter = 0 To 100
If cell.Offset(-tmpcounter, 0).Value = "Op" Or cell.Offset(-tmpcounter, 0).Value = "Check" Then
PageBreakRowNo = cell.Offset(-tmpcounter + 1, 0).Row
tmpcounter1 = tmpcounter
Debug.Print "Op / Check found at row " & PageBreakRowNo
Sheets("Dispensary").HPageBreaks.Add Before:=cell.Offset(-tmpcounter + 2, 0)
Exit for 'to stop looking upwards
End If
Next tmpcounter
HowTall = 0 'reset HowTall to start again for the next page
For i = tmpcounter1 +1 to 0 Step -1 'Calculate the HowTall lost due to stepping back
HowTall = HowTall + cell.Offset(i,0).RowHeight
Next i
End If ' end of of HowTall >832 loop
Next 'end of for each cell in Column B loop
End Sub
I’m using a userform with 12 listboxes (numbered 2-13). Each list box could contain 0-8 items assigned by user from main listbox1. I run the following code to output the content of each list box (12 boxes) to sheet “Tray” when a button is pressed.
Each listbox is then output into corresponding columns of each tray from columns B-M. Listbox2 fills column 1 of each tray and so on. A maximum of 4 trays can be filled. The code checks the 1st well of each tray and if it contains a value it assumes the tray is full & begins filling the next tray.
Problem: If the first tray contains a blank column(listbox) and the second tray contains values in the same listbox, the code will fill blank column of the frist tray with values that should be in the second tray. Please see pictures below and updated code below:
Listboxes 2,3 and 4 for Tray 1 (note listbox3 is empty)
Listboxes 2,3 and 4 for tray 2 (note listbox3 has data)
Code ran two times: Listbox3 from tray2 appears in tray1 (erroneously!!!)
Expected output:
Sub Worklist()
'
Dim Var, VarName As Variant
Dim i, DblDashPos, FirstPeriodPos, lngColNum, lngRowNum As Long
Dim item As ListBox
Const cstrNames As String = "Listbox2,Listbox3,Listbox4,Listbox5,Listbox6,Listbox7,Listbox8,Listbox9,Listbox10,Listbox11,Listbox12,Listbox13"
Application.ScreenUpdating = False
lngColNum = 2
For Each VarName In Split(cstrNames, ",")
If UserForm2.Controls(VarName).ListIndex <> -1 Then 'if listbox is not blank
If Sheets("Tray").Cells(4, lngColNum).Value = 0 Then
'checks if value in row 3 column "lngColNum" is empty
lngRowNum = 4
ThisWorkbook.Sheets("Tray").Range("C2").Value = UserForm2.TextBox1.Value
ElseIf Sheets("Tray").Cells(15, lngColNum).Value = 0 Then 'checks if value in row 14 column "lngColNum" is empty
lngRowNum = 15
ThisWorkbook.Sheets("Tray").Range("C13").Value = UserForm2.TextBox1.Value
ElseIf Sheets("Tray").Cells(26, lngColNum).Value = 0 Then 'checks if value in row 14 column "lngColNum" is empty
lngRowNum = 26
ThisWorkbook.Sheets("Tray").Range("C24").Value = UserForm2.TextBox1.Value
Else 'otherwise assumes tray starts in row 5, column "lngColNum"
lngRowNum = 37
ThisWorkbook.Sheets("Tray").Range("C35").Value = UserForm2.TextBox1.Value
End If
For i = 0 To UserForm2.Controls(VarName).ListCount - 1
Var = UserForm2.Controls(VarName).List(i)
DblDashPos = InStr(1, Var, "--")
FirstPeriodPos = InStr(1, Var, ".")
Sheets("Tray").Select
ActiveSheet.Cells(lngRowNum, lngColNum) = Left(Var, DblDashPos - 1) & Right(Var, Len(Var) - FirstPeriodPos + 1)
lngRowNum = lngRowNum + 1
Next i
End If
lngColNum = lngColNum + 1
Next
Application.ScreenUpdating = True
End Sub
Thank you very much!
The problem is that you're only testing the column that corresponds to the ListBox to see if the cell is empty. If you want to test that all of the columns in a "tray" are empty, you need to test once for the entire sheet. Something like this (untested because I'm too lazy to rebuild your form):
Private Function FindFirstUnusedRow(sheet As Worksheet) As Long
Dim testColumn As Long, testRow As Long
Dim used As Boolean
For testRow = 4 To 37 Step 11
used = False
For testColumn = 2 To 13
If IsEmpty(sheet.Cells(testRow, testColumn)) = False Then
used = True
Exit For
End If
Next testColumn
If used = False Then
FindFirstUnusedRow = testRow
Exit For
End If
Next testRow
End Function
Then in your code, call it before your loop:
Sub Worklist()
Dim var As Variant
Dim i As Long, dashPos As Long, periodPos As Long, colNum As Long
Dim rowNum As Long, Dim sheet As Worksheet
Application.ScreenUpdating = False
Set sheet = ThisWorkbook.Sheets("Tray")
rowNum = FindFirstUnusedRow(sheet)
If rowNum = 0 Then
Debug.Print "All trays full."
Exit Sub
End If
Dim current As ListBox
For colNum = 2 To 13
Set current = UserForm2.Controls("Listbox" & colNum)
If current.ListIndex <> -1 Then 'if listbox is not blank
sheet.Cells(rowNum - 2, colNum).Value = UserForm2.TextBox1.Value
For i = 0 To current.ListCount - 1
var = current.List(i)
dashPos = InStr(1, var, "--")
periodPos = InStr(1, var, ".")
sheet.Cells(rowNum + i, colNum) = Left$(var, dashPos - 1) & _
Right$(var, Len(var) - periodPos + 1)
Next i
End If
Next colNum
Application.ScreenUpdating = True
End Sub
A couple other notes: You can ditch the Sheets("Tray").Select line entirely - you never use the selection object. Same thing with the mixed references to ActiveSheet and ThisWorkbook.Sheets("Tray"). Grab a reference and use it.
Also, these lines don't do what you think they do:
Dim Var, VarName As Variant
Dim i, DblDashPos, FirstPeriodPos, lngColNum, lngRowNum As Long
Of all the variables you declare, everything is a Variant except lngRowNum. If you want to combine declarations on one line like that, you still need to specify a type for each variable, or they'll default to Variant. See the example code above.