I need to use Collection variable in Global scope. But if i declare collection as public I can use it only in module sheet or worksheet. I need to declare it for entire workbook scope to use it in workbook functions, worksheet functions and module functions.
ThisWorkbook
Public foo As New Collection
Worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
row= Target.Row
column= Target.Column
If Cells(row, 2).Value = "" Then
Exit Sub
Else
If Cells(row, 1).Value = "" Then
foo.Add row- 5
Cells(row, 1).Value = "X"
Cells(row, 2).Select
Cells(row, 14).Value = True
Else
foo.Remove row- 5
Cells(row, 1).Value = ""
Cells(row, 2).Select
Cells(row, 14) = False
End If
End If
Application.ScreenUpdating = True
End Sub
Module:
Sub col()
MsgBox foo.Count
End Sub
In a Standard Module:
Private m_collection As Collection
Public Property Get TheCollection() As Collection
If m_collection Is Nothing Then Set m_collection = New Collection
Set TheCollection = m_collection
End Property
Then you can call it from anywhere in your code.
ModuleName.TheCollection.Add("whatever")
Related
Can anyone help me with a solution or a different method for this? I would like to edit the filtered listbox
I'm trying to get a listbox that is able to display my sheet1 and be able to filter all the blanks/not found in column A. I also want to be able to edit the listbox aswell
I would like my userform2 listbox to display the sheet1 information.
There will also be a checkbox which will filter the listbox to show “not found” or blank lines.
If i double click the selected item on the listbox i would like to edit the information
for userform2
Private Sub ListBox2_Click()
TextBox1.Enabled = True
TextBox1.Value = ListBox2.Value
End Sub
Private Sub TextBox1_Change()
Dim rCell As Range
With ListBox2
Set rCell = Range(.RowSource).Resize(1).Offset(.ListIndex)
rCell.Value = TextBox1.Value
End With
End Sub
Private Sub CheckBox1_Click()
OptimizedMode True
If userform2.CheckBox1.Value = True Then
Worksheets("Table").Range("A1").AutoFilter Field:=1, Criteria1:="Not Found", Operator:=xlOr, Criteria2:="="
userform2.ListBox2.RowSource = vbNullString
userform2.ListBox2.ColumnHeads = False
Dim rng As Range
Dim Cel1 As Range
Dim LR As Long
Dim ws As Worksheet
Set ws = Sheets("Table")
With ws
LR = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2:A" & LR).SpecialCells(xlCellTypeVisible)
With userform2.ListBox2
.ColumnCount = 1
For Each Cel1 In rng
.AddItem CStr(Cel1.Value)
.List(.ListCount - 1, 1) = Cel1.Offset(0, 1).Value
Next Cel1
End With
End With
End If
If CheckBox1.Value = False Then
With userform2.ListBox2
.RowSource = "Table!A2:A1048576"
End With
End If
OptimizedMode False
End Sub
I've re-designed my code and I believe this will achieve what you are after.
NOTE: This code uses all default object names. You will need to modify it to target the names for your workbook, sheet, useform, controls etc, if you wish to implement into your project.
In designing this answer I used the following:
A new blank Workbook with 1 new Worksheet
A new UserForm (captioned "ListBox Editor") with 1 ListBox that has 2 columns (ColumnCount = 2) and 1 CheckBox (captioned "Show Blanks").
The sample data I used was in Range("A1:A10") filling only odd numbers from row 1. This allows testing for including/excluding blank/empty rows. Screenshots of the Worksheet and UserForm below.
Worksheet data:
UserForms both with and without blanks in the listbox:
All code is written in the code behind module for the UserForm
Most can be written into any other module with calls made to the subs/functions from the UserForm/ListBox events if you'd prefer not to have the working code in the UserForm module.
Code blocks with explanations below (full code block at the end for copy/paste):
Option Explicit
Option Explicit should be included at the top of each and every code module you use. It forces explicit declaration of all variables which helps significantly in avoiding typo's in your code etc.
Private Sub PopulateListBox(ByVal IncludeBlanks As Boolean)
Dim TargetCell As Range
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
With UserForm1.ListBox1
.Clear
For Each TargetCell In TargetWorksheet.Range("A1:A10")
If Not IncludeBlanks Then
If Not TargetCell.Value = "" Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
ElseIf IncludeBlanks Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
Next TargetCell
.ColumnWidths = ";0" 'Hides listbox column that holds row number
End With
End Sub
PopulateListBox is a subroutine I wrote to handle population of the items in the ListBox. It first clears the list, allowing each population of the listbox to be 'refreshed' data. Then it iterates through each TargetCell of the defined Range. If IncludeBlanks is True it has no conditions to meet and adds each cell value into the list, if IncludeBlanks is False it will only add the cell value to the list if the value is not "".
Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = False Then
PopulateListBox False
ElseIf Me.CheckBox1.Value = True Then
PopulateListBox True
End If
End Sub
This _Click event simply updates the ListBox list based on if the CheckBox is checked or not. The CheckBox represents if you are including blanks/empty cells or not so it passes True or False respective to it's Value, to the IncludeBlanks argument in PopulateListBox.
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim NewValue As Variant
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
NewValue = InputBox("What is the new value to replace " & UserForm1.ListBox1 & "?")
If Not StrPtr(NewValue) = 0 Then 'Check user did NOT click cancel or [X]
With ListBox1
If NewValue = "" Then NewValue = vbNullString
TargetWorksheet.Cells(.List(.ListIndex, 1), 1).Value = NewValue
.AddItem NewValue, .ListIndex
.RemoveItem .ListIndex
End With
End If
End Sub
The _DblClick Event triggers the code when a list item is double clicked. This code first opens an InputBox to allow the user to enter a new value for the selected listbox item. When the user clicks OK or hit's Enter, the new value is first written to the Cell that the original value came from, then the new value is added as a new list item and finally the previous value is removed. If the user clicks [X] or 'Cancel' the code does nothing.
Private Sub UserForm_Initialize()
PopulateListBox False
End Sub
Much the same as the Checkbox_Change code, this simply populates the ListBox when the UserForm is first initialized. It's written to exclude blanks, specified by False for the IncludeBlanks argument.
Put it all together and you have:
Option Explicit
Private Sub CheckBox1_Click()
If Me.CheckBox1.Value = False Then
PopulateListBox False
ElseIf Me.CheckBox1.Value = True Then
PopulateListBox True
End If
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim NewValue As Variant
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
NewValue = InputBox("What is the new value to replace " & UserForm1.ListBox1 & "?")
If Not StrPtr(NewValue) = 0 Then 'Check user did NOT click cancel or [X]
With ListBox1
If NewValue = "" Then NewValue = vbNullString
TargetWorksheet.Cells(.List(.ListIndex, 1), 1).Value = NewValue
.AddItem NewValue, .ListIndex
.RemoveItem .ListIndex
End With
End If
End Sub
Private Sub UserForm_Initialize()
PopulateListBox False
End Sub
Private Sub PopulateListBox(ByVal IncludeBlanks As Boolean)
Dim TargetCell As Range
Dim TargetWorksheet As Worksheet
Set TargetWorksheet = ThisWorkbook.Sheets("Sheet1")
With UserForm1.ListBox1
.Clear
For Each TargetCell In Range("A1:A10")
If Not IncludeBlanks Then
If Not TargetCell.Value = "" Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
ElseIf IncludeBlanks Then
.AddItem TargetCell.Value
.List(.ListCount - 1, 1) = TargetCell.Row
End If
Next TargetCell
.ColumnWidths = ";0"
End With
End Sub
I Have an Issue to call Another Module (Run Time Error'424': Object Required). I have 2 Modules, Module 1 and Module 2. And Below is the code in Module 1 :
Private Sub test()
Dim Work As Worksheet: Set work= Sheets("S_BDN")
For i = 1 To 2
Set f = work.Range("A5", work.Range("A5").End(xlDown))
Set a = f.Find(i, LookIn:=xlValues)
If a.Offset(0, 10).Value = "January" Then
Call Module3.Proceed_B
End If
Next i
End Sub
And Below is the code in Module 2 :
sub Module3.Proceed_B()
If a.Offset(0, 6).Value = "A" Then
Debug.Print a.Offset(0, 4).Value
else
Debug.Print a.Offset(0, 5).Value
end if
end sub
All help is greatly appreciated. Thank you.
I can't see your "fixed" code or your sheet, so here are some generic suggestions for improvement:
Private Sub test()
Dim Work As Worksheet, f As Range, a As Range
Set work= Sheets("S_BDN")
Set f = work.Range("A5", work.Range("A5").End(xlDown)) 'take out of loop
For i = 1 To 2
Set a = Nothing
Set a = f.Find(i, LookIn:=xlValues, lookat:=xlWhole) 'provide *all* relevant parameters
If Not a Is Nothing Then 'make sure you got a match
If a.Offset(0, 10).Value = "January" Then
Proceed_B a 'pass a to the other sub
End If
End If
Next i
End Sub
sub Proceed_B(a As Range)
If a.Offset(0, 6).Value = "A" Then
Debug.Print a.Offset(0, 4).Value
else
Debug.Print a.Offset(0, 5).Value
end if
end sub
I am facing a problem in getting the sequence of the unique numbers(Serial number) when the userform is closed and opened later on. Firstly, when I fill the data in the userform everything is captured in the excel sheet perfectly with correct sequence; if I close the userform and run the code by filling the userform with new data the unique ID's are again starting from "1" but not according to the excel sheet row number which was previously saved.
Below is the code I tried:
Private Sub cmdSubmit_Click()
Dim WB As Workbook
Dim lr As Long
Set WB = Workbooks.Open("C:\Users\Desktop\Book2.xlsx")
Dim Database As Worksheet
Set Database = WB.Worksheets("Sheet1")
eRow = Database.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
lr = Database.Range("a65536").End(xlUp).Row
With Sheets("Sheet1")
If IsEmpty(.Range("A1")) Then
.Range("A1").Value = 0
Else
Database.Cells(lr + 1, 1) = Val(Database.Cells(lr, 1)) + 1
End If
End With
Database.Cells(eRow, 4).Value = cmbls.Text
Database.Cells(eRow, 2).Value = txtProject.Text
Database.Cells(eRow, 3).Value = txtEovia.Text
Database.Cells(eRow, 1).Value = txtUid.Text
Call UserForm_Initialize
WB.SaveAs ("C:\Users\Desktop\Book2.xlsx")
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber
If Not Intersect(Target, Range("B:B")) Is Nothing Then
' don't run when more than one row is changed
If Target.Rows.Count > 1 Then Exit Sub
' if column A in the current row has a value, don't run
If Cells(Target.Row, 1) > 0 Then Exit Sub
' get the highest number in column A, then add 1 and write to the
' current row, column A
maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
Target.Offset(0, -1) = maxNumber + 1
End If
End Sub
Private Sub UserForm_Initialize()
With txtUid
.Value = Format(Val(Cells(Rows.Count, 1).End(xlUp)) + 1, "0000")
.Enabled = False
End With
With txtProject
.Value = ""
.SetFocus
End With
End Sub
In this image if you see unique id's are repeating 1 and 2, but I need as 1,2,3,4....
I think this is where the issue is coming from. You need to re-calculate the last row every time the user form is Initialized.
Private Sub UserForm_Initialize()
Dim ws as Worksheet: Set ws = Thisworkbook.Sheets("Database")
With txtUid
.Value = Format(ws.Range("A" & ws.Rows.Count).End(xlUp) + 1, "0000")
.Enabled = False
End With
With txtProject
.Value = ""
.SetFocus
End With
End Sub
It's always risky to use row numbers or [max range value +1] as a sequence number.
Safer to use something like a name scoped to the worksheet, which has a value you can increment. Then the sequence is independent of your data.
E.g.
Function GetNextSequence(sht As Worksheet) As Long
Const SEQ_NAME As String = "SEQ"
Dim nm As Name, rv As Long
On Error Resume Next
Set nm = sht.Names(SEQ_NAME)
On Error GoTo 0
'add the name if it doesn't exist
If nm Is Nothing Then
Set nm = sht.Names.Add(Name:=SEQ_NAME, RefersToR1C1:="=0")
End If
rv = Evaluate(nm.Value) + 1
nm.Value = rv
GetNextSequence = rv
End Function
I have a table that ranges from F2 to G230 . The F column is employee number and G column is employee name. Im trying to make a simple program that registers food orders for the employees and exports the data into a table. Everything works fine except when I choose a employee from a drop down list I want the employee number to appear in a textbox.
Here is my whole code:
Private Sub cmdbutton_add_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("listi yfir skráningar")
'find first empty row in database
iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
'check for a Name number
If Trim(Me.combobox_name.Value) = "" Then
Me.combobox_name.SetFocus
MsgBox "Please complete the form"
Exit Sub
End If
'copy the data to the database
ws.Cells(iRow, 1).Value = Me.textbox_staffnr.Value
ws.Cells(iRow, 2).Value = Me.combobox_name.Value
ws.Cells(iRow, 3).Value = Me.combobox_rettir.Value
ws.Cells(iRow, 4).Value = Me.textbox_verd.Value
ws.Cells(iRow, 5).Value = Me.textbox_dags.Value
MsgBox "Komið :)", vbOKOnly + vbInformation, "Komið"
'clear the data
Me.combobox_name.Value = ""
Me.combobox_name.SetFocus
Unload Me
End Sub
Private Sub Cmdbutton_close_Click()
Unload Me
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub combobox_name_Change()
textbox_staffnr.Value = Application.VLookup(Me.combobox_name.Value, Sheet3.Range("F2:G230"), 1, 0)
End Sub
Private Sub combobox_rettir_Change()
textbox_verd.Value = Application.VLookup(Me.combobox_rettir.Value, Sheet3.Range("C2:D23"), 2, 0)
End Sub
Private Sub Name_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub textbox_staffnr_Change()
End Sub
Private Sub textbox_verd_Change()
End Sub
Private Sub UserForm_Initialize()
textbox_dags.Value = Format(Date, "dd/mm/yyyy")
End Sub
And here Im getting error:
Private Sub combobox_name_Change()
textbox_staffnr.Value = Application.VLookup(Me.combobox_name.Value, Sheet3.Range("F2:G230"), 1, 0)
End Sub
Please help.
EDIT: From user's comment:
The number is in column 1 and the name is in column 2
In that case, Vlookup won't work, you'll need to use Index/Match, or a Range.Find.Offset. Personally I prefer the Range.Find.Offset while in VBA:
Dim rngFound as Range
Set rngFound = Sheet3.Range("G2:G230").Find(Me.combobox_name.Value, , xlValues, xlWhole)
If not rngFound is Nothing Then textbox_staffnr.Value = rngFound.Offset(0, -1).Text
Pretty much I have a loop that I want to run through, however I don't want it to go to the next "i" until a button is pressed. My code is as follows. I believe my trouble is the location of the "If GoGo" but I have tried it in many places.
Sub GoGo()
Public GoGo As Boolean
GoGo = True
End Sub
Sub Runn()
Dim lastrow As Long, i As Long
For i = 23 To 32
DoEvents
If GoGo = True Then
If Cells(i, 1) <> 0 Then
Range("B5").Value = Cells(i, 2).Value
Range("E5").Value = Cells(i, 3).Value
Range("E11").Value = Range("C33").Value
Application.Run ("Realcount")
Application.Run ("Realcount2")
End If
End If
Next i
End Sub
Is this what you are trying?
Public GoGo As Boolean
Sub GoGoProc()
GoGo = True
End Sub
Sub Runn()
Dim lastrow As Long, i As Long
i = 23
Do
DoEvents
If GoGo = True Then
If Cells(i, 1) <> 0 Then
Range("B5").Value = Cells(i, 2).Value
Range("E5").Value = Cells(i, 3).Value
Range("E11").Value = Range("C33").Value
Application.Run ("Realcount")
Application.Run ("Realcount2")
End If
i = i + 1
GoGo = False
End If
Loop
End Sub
FOLLOWUP (From Comments)
Instead of using a loop, the best way I can think of is using a modeless userform (so that you want work with the Workbook/Worksheet at the same time) with a Next button. The Next button will increment the row value and then run the code. This way you will not keep Excel busy if you had to leave say for a cup of coffee ;)
Create Userform (UNTESTED) which should look like this
Paste this code in the userform
'~~> Next Button
Private Sub CommandButton1_Click()
Range("B5").Value = Cells(rw, 2).Value
Range("E5").Value = Cells(rw, 3).Value
Range("E11").Value = Range("C33").Value
Application.Run ("Realcount")
Application.Run ("Realcount2")
rw = rw + 1
End Sub
'~~> Canecel Button
Private Sub CommandButton2_Click()
Unload Me
End Sub
Create a Module and paste this code there
Public rw As Long
Sub Launch()
rw = 23
UserForm1.Show vbModeless
End Sub
To run your code, you can either run Sub Launch() directly or create a Command Button (Form Control - I guess that is what you are using) on your worksheet and assign Sub Launch() to it.