Sub or Function in VBA Excel - vba

I'm trying to create a function or sub to create a report in VBA Excel. I want the user to Enter two dates into two separate text boxes. Then when the submit button is clicked it checks if the text boxes are empty or not then if they aren't it preforms the CreateReport() Sub or function which creates a new sheet and appends data to it. Here is my code:
Userform2:
Private Sub Cancel_Click()
Unload Me
End Sub
Private Sub Submit_Click()
If UserForm2.Date1.Value = "" & UserForm2.Date2.Value = "" Then
Value1 = UserForm2.Date1.Value
Value2 = UserForm2.Date2.Value
CreateReport(Value1,Value2)
End If
End Sub
Private Sub UserForm_Initialize()
Date1.SetFocus
Dim Value1 As String
Dim Value2 As String
End Sub
Module1:
Option Explicit
Public Function CreateSheet(Name1 As String, Name2 As String)
Dim WS As Worksheet
Dim FullName As String
FullName = Name1 & "-" & Name2
Set WS = Sheets.Add.Name = FullName
End Function
Public Sub CreateReport(Date1 As String, Date2 As String)
End Sub

You're calling CreateReport when there are no dates entered...
Also
CreateReport(Value1,Value2)
should be
CreateReport Value1, Value2
you don't use parentheses unless you're calling a function or using the Call keyword.
And
Set WS = Sheets.Add.Name = FullName
should probably be
Set WS = Sheets.Add()
WS.Name = FullName

Related

Passing a variable from class module to userform

Hej,
I am trying to design a code, where a number of commandbuttons call the same userform. I have created the class module and got it to work so that they all call the userform, but I need the name of the button passed on from the class module into the userform initialize. I have tried it with property get and a public function, but can't get it to work. The variable I want to pass is the "ScreenShotCap" as string Anyone, who can help?
CLASS MODULE CODE
Option Explicit
Public ScreenShotCap As String
Public WithEvents CmdBtn As MSForms.CommandButton
Property Set obj(btns As MSForms.CommandButton)
'Defines the property of the object called
Set CmdBtn = btns
End Property
Private Sub CmdBtn_Click()
'Gets the button caption
ScreenShotCap = CmdBtn.Name
'Loads the userform
ufScreenshot.Show
End Sub
USERFORM CODE
Private Sub UserForm_Initialize()
Dim btnNo As Variant
Dim imNo1, imNo2, imNo3 As Integer
'Gets the number of the button
btnNo = Right(ScreenShotCap, 1)
'Sets the image number
imNo1 = Int(btnNo + 2)
imNo2 = Int(btnNo + 3)
imNo3 = Int(btnNo + 4)
'Loads the image from MSForms into userform
If ScreenShotCap = Worksheets("SW_TEST").OLEObjects("CommandButton1").Name Then
Application.ScreenUpdating = False
Me.Image1.Picture = Worksheets("SW_TEST").OLEObjects("Image1").Object.Picture
Me.Image2.Picture = Worksheets("SW_TEST").OLEObjects("Image2").Object.Picture
Me.Image3.Picture = Worksheets("SW_TEST").OLEObjects("Image3").Object.Picture
Application.ScreenUpdating = True
Else
Application.ScreenUpdating = False
Me.Image1.Picture = Worksheets("SW_TEST").OLEObjects("Image" & imNo1).Object.Picture
Me.Image2.Picture = Worksheets("SW_TEST").OLEObjects("Image" & imNo2).Object.Picture
Me.Image3.Picture = Worksheets("SW_TEST").OLEObjects("Image" & imNo3).Object.Picture
'after any change vba has to be told to refresh the UserForm for the change to appear
Me.Repaint
Application.ScreenUpdating = True
End If
End Sub
Move the codes in UserForm_Initialize() to a new sub with a parameter or just rename it to:
Public Sub LoadButtonImage(ScreenShotCap As String)
Then in your CmdBtn_Click() sub:
Load ufScreenshot.Show
ufScreenshot.LoadButtonImage CmdBtn.Name
uScreenshot.Show

One event sub for multiple textboxes instead of declaring it multiple time?

Is it possible to have one change event procedure for multiple textboxes in the same workbook?
If for example, I have a textbox named "textbox3" in the 1st, 2nd, and 3rd sheet of the workbook and I would like this single code below to work for all of them (the textboxes) rather than having to declare it on each sheet. Right now, I have to declare the same procedure on all the sheets but I only want to declare it once since it does the same thing on all of them.
'my procedure
Sub testObj()
Dim i As Integer, obj As oleobject
Set ac = ThisWorkbook.ActiveSheet
For Each obj In ac.oleobjects
If TypeName(obj.Object) = "TextBox" And obj.name = "TextBox3" Then
i = i + 1
ReDim Preserve TextArray(1 To i)
Set TextArray(i).TextBoxEvents = obj
End If
Next obj
Set obj = Nothing
End Sub
'My class1
Public WithEvents TextBoxEvents As MSForms.TextBox
'Public WithEvents TextBoxEvents As OLEObject
Private Sub TextBoxEvents_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyTab Then
TextBox12.Activate
End If
End Sub
Here's an example
Class module named clsTextBox:
Option Explicit
Public WithEvents TextBoxEvents As MSForms.TextBox
Private Sub TextBoxEvents_Change()
Debug.Print TextBoxEvents.Name & ": " & TextBoxEvents.Text
End Sub
'Private Sub TextBoxEvents_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
' If KeyCode = vbKeyTab Then
' TextBox12.Activate 'unclear what you're aiming for here?
' End If
'End Sub
Regular module:
Dim ColTB As Collection
Sub testObj()
Dim i As Integer, obj As OLEObject, ac As Worksheet
Set ac = ThisWorkbook.ActiveSheet
Set ColTB = New Collection
For Each obj In ac.OLEObjects
If TypeName(obj.Object) = "TextBox" Then
ColTB.Add EventObj(obj.Object)
End If
Next obj
Set obj = Nothing
End Sub
Function EventObj(obj As MSForms.TextBox) As clsTextBox
Dim o As New clsTextBox
Set o.TextBoxEvents = obj
Set EventObj = o
End Function

Get values from collection in one module into combobox in userform

I have a worksheet with data in column 'EGM'. My code saves values from this column in the collection.
If there is only one value in the collection, then variable sSelectedEGM is equal to this value.
But if there is more than one values, a user should has possibility to choose only one value (I wanted to do this in the combobox) and save selected item into variable sSelectedEGM.
My problem is, that I can't get values from this collection into userform.
When my code go into useform, the error "Type mismatch" appear. My code in worksheet:
Public sSelectedEGM As String
Public vElement As Variant
Public cEGMList As New VBA.Collection
Sub kolekcjaproba()
' ===================================
' LOOP THROUGH EGMS AND WRITE THEM INTO COLLECTION
' ===================================
Dim iOpenedFileFirstEGMRow As Integer
Dim iOpenedFileLastEGMRow As Integer
Dim iOpenedFileEGMColumn As Integer
Dim iOpenedFileEGMRow As Integer
Dim sOpenedFileEGMName As String
Dim ws As Worksheet
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Worksheets(1)
iOpenedFileFirstEGMRow = Cells.Find("EGM").Offset(1, 0).Row
iOpenedFileLastEGMRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, iOpenedFileFirstEGMRow).End(xlUp).Row
iOpenedFileEGMColumn = Cells.Find("EGM").Column
For iOpenedFileEGMRow = iOpenedFileFirstEGMRow To iOpenedFileLastEGMRow
sOpenedFileEGMName = Cells(iOpenedFileEGMRow, iOpenedFileEGMColumn).Value
For Each vElement In cEGMList
If vElement = sOpenedFileEGMName Then
GoTo NextEGM
End If
Next vElement
cEGMList.Add sOpenedFileEGMName
NextEGM:
Next
If cEGMList.Count = 1 Then
sSelectedEGM = cEGMList.Item(1)
ElseIf cEGMList.Count = 0 Then
MsgBox "No EGM found"
Else
Load UserForm1
UserForm1.Show
End If
End Sub
And my code in a userform (There is only a combobox on it)
Private Sub UserForm_Initialize()
For Each vElement In cEGMList
UserForm1.ComboBox1.AddItem vElement
Next vElement
End Sub
Private Sub ComboBox1_Change()
If ComboBox1.ListIndex <> -1 Then
sSelectedEGM = ComboBox1.List(ComboBox1.ListIndex)
End If
End Sub
you have to declare cEGMList and sSelectedEGM in a standard module as public and not in a worksheet module.
Or even better: create a property on the form for the collection and for the returned values. It's always better to avoid global vars wherever possible.
This is a simplified example. In the form you can define properties and methods like that:
Option Explicit
Public TestProperty As Integer
Public Sub TestMethod()
MsgBox (TestProperty)
End Sub
Public Function TestMethodWithReturn() As Integer
TestMethodWithReturn = TestProperty * 2
End Function
outside the form you can then use this as a normal property/method of the form:
Private Sub Test()
Dim retValue As Integer
UserForm1.TestProperty = 123
UserForm1.Show vbModeless
UserForm1.TestMethod
retValue = UserForm1.TestMethodWithReturn
Debug.Print retValue
End Sub

Using a sub var into other sub visual basic

How can i get a var value from a sub by calling it in other sub ? like
Sub test()
Dim a As Integer
a = 1
End Sub
Sub testshow()
MessageBox.Show(test.a)
End Sub
In VBA (which your tag states) you need to change Sub into Function which will be:
Function test()
Dim a As Integer
a = 1
test = a
End Function
Sub testshow()
MsgBox test
End Sub
EDIT after comment: If you using more then one variable then:
Function test(whichVar)
Dim a As Integer
If whichVar = 1 then
a = 100
ElseIf whichVar = 2 Then
a = 200
'etc...
End if
test = a
End Function
Sub testshow()
MsgBox test(2) 'will give you 200
End Sub

Tearing Down Circular References

The following code creates a circular reference for each element in the collection. Is the code in the UserForm_Terminate routine sufficient to tear down the relationships to allow the memory to be released? Or is there a requirement to use pointers and weak references?
If so/not what is the best method for testing whether the objects have been released?
Userform Code:
Option Explicit
Implements IBtnClick
Dim coll As Collection
Private Sub UserForm_Initialize()
Dim x As Long
Dim e As CBtnEvents
Set coll = New Collection
For x = 1 To 5
Set e = New CBtnEvents
Set e.btn = Me.Controls.Add("Forms.CommandButton.1")
e.ID = x
e.Register Me
With e.btn
.Height = 30
.Width = 30
.Top = 10
.Left = .Width * x
End With
coll.Add e
Next x
End Sub
Private Sub UserForm_Terminate()
Dim itm
For Each itm In coll
msgbox itm.ID
itm.Unregister
Next itm
End Sub
Private Sub IBtnClick_click(ID As Long)
MsgBox ID
End Sub
IBtnClick Code:
Public Sub click(ID As Long)
End Sub
CBtnEvents Code:
Private WithEvents p_btn As MSForms.CommandButton
Private p_ID As Long
Private click As IBtnClick
Public Property Set btn(value As MSForms.CommandButton)
Set p_btn = value
End Property
Public Property Get btn() As MSForms.CommandButton
Set btn = p_btn
End Property
Public Sub Register(value As IBtnClick)
Set click = value
End Sub
Public Sub Unregister()
Set click = Nothing
End Sub
Private Sub p_btn_Click()
click.click p_ID
End Sub
Public Property Get ID() As Long
ID = p_ID
End Property
Public Property Let ID(ByVal lID As Long)
p_ID = lID
End Property
Private Sub Class_Terminate()
MsgBox p_ID
End Sub
I have included the VB6 tag as I think the question applies equally, but I am using Excel VBA.
This is how we (manually) keep our instance book-keeping collection:
In every class/form/control we place something like this
Option Explicit
DefObj A-Z
Private Const MODULE_NAME As String = "cTransStub"
'=========================================================================
' Constants and member variables
'=========================================================================
' Consts here
' Vars here
#If DebugMode Then
Private m_sDebugID As String
#End If
' Props here
' Methods here
'=========================================================================
' Base class events
'=========================================================================
#If DebugMode Then
Private Sub Class_Initialize()
DebugInstanceInit MODULE_NAME, m_sDebugID, Me
End Sub
Private Sub Class_Terminate()
DebugInstanceTerm MODULE_NAME, m_sDebugID
End Sub
#End If
Sample implementation of helper DebugInstanceInit/Term subs that populate DebugIDs collection:
Public Sub DebugInstanceInit(sModuleName As String, sDebugID As String, oObj As Object)
Dim sCount As String
Dim lObjPtr As Long
Dim sObjCtx As String
On Error Resume Next
sDebugID = sDebugID & GetDebugID()
If DebugIDs Is Nothing Then
Else
...
lObjPtr = ObjPtr(oObj)
DebugIDs.Add sDebugID & " " & LIB_NAME & "." & sModuleName & "|&H" & Hex(lObjPtr) & "|" & Format$(time, "hh:mm:ss") & "|" & sObjCtx & "|", "#" & sDebugID
End If
...
If Not DebugConsole Is Nothing Then
DebugConsole.RefreshConsole
End If
On Error GoTo 0
End Sub
Public Sub DebugInstanceTerm(sModuleName As String, sDebugID As String)
On Error Resume Next
If DebugIDs Is Nothing Then
Else
DebugIDs.Remove "#" & sDebugID
End If
...
If Not DebugIDs Is Nothing Then
If DebugIDs.Count = 0 Then
Debug.Print "DebugIDs collection is empty"; Timer
End If
End If
If Not DebugConsole Is Nothing Then
DebugConsole.RefreshConsole
End If
On Error GoTo 0
End Sub
Upon program termination we warn for any object leaking in DebugIDs collection.