I'm trying to inspect an object when a new instance is created. The instance is created with a function DaySchedule.Create(). I can do that because I set the attribute VB_PredeclaredId = True. Here's the code of the function:
Public Function Create( _
ByVal Name As String, _
ByVal Cycle As Long, _
ByVal Prio As Long, _
ByVal startDate As Date, _
ByVal WeekDays As String) As WeekSchedule
Dim WeekDays_Arr() As String
Dim Days As Variant
me_Monday = False
me_Tuesday = False
me_Wednesday = False
me_Thursday = False
me_Friday = False
me_Saturday = False
me_Sunday = False
WeekDays_Arr = Split(WeekDays, ";")
For Each Days In WeekDays_Arr
Select Case Days
Case "Mo": me_Monday = True
Case "Tu": me_Tuesday = True
Case "We": me_Wednesday = True
Case "Th": me_Thursday = True
Case "Fr": me_Friday = True
Case "Sa": me_Saturday = True
Case "Su": me_Sunday = True
End Select
Next Days
me_ScheduleType = "weekly"
me_Name = Name
me_Cycle = Cycle
me_Prio = Prio
me_StartDate = startDate
Set Create = Me
End Function
The problem is whenever I open the locals window and try to expand Me Excel is loading infinitly. Sometimes it works after 20 seconds or so, but then every line take's 20 seconds. My CPU load is only 15% and I dont have other functions in the Excel workbook that might be calculated. Yesterday I have done exactly the same thing and it expanded instantly. Does anyone have a similar issue or the solution?
I found the solution. The problem lied in a property named Schedule_NextBackup. The Get-property didn't set a property but calculated something. I changed it to a function and it doesn't lag anymore.
Related
I understand that the type structure is the ancestor of the class function. However coding a Type structure is quick, simple and easy. Thus I tried the following without success.
Working inside a class in VBa, I tried to return multiple variables from an internal function to another function within the class. I have tried to do that with a type element, however there is an internal conflict within the class function.
I have two questions:
1.) Are types not allowed in classes?
2.) What is a good practice method for returning multi-variable outputs from a function within a class?
Private Type checkResult
status As Boolean
errorp As String
End Type
Function CheckPTID(PTid As String) As checkResult
Dim plen As Boolean ' PT length
Dim numdash As Boolean ' numbers and dashes
Dim titles As Boolean ' Tiles correct
' initials
plen = False
numdash = False
titles = False
' Checks
If Len(PTid) = 8 Then plen = True
If InStr(PTid, "-") > -1 Then numdash = True
If (Left(PTid, 2) = "XP" Or Left(PTid, 2) = "XA") Then titles = True
' output
If (plen = False Or numbdash = False Or titles = False) Then
CheckPTID.status = False
If Not plen Then CheckPTID.errorp = "** Error Name length incorrect:" & PTid
If Not numdash Then CheckPTID.errorp = "** Error Name format incorrect:" & PTid
If Not titles Then CheckPTID.errorp = "** Error Name titles incorrect:" & PTid
Else
CheckPTID.status = True
CheckPTID.errorp = "N/A"
End If
End Function
Error given in above code is: User-defined type not defined. Thanks
EDIT:
To help with the understanding of the structure. The following is shown :
Class
|--Properties
|--Function: CheckPTID
|--Type: checkResult
The real question is, how does one use the type function directly in a class without creating a new class.
Working inside a class in VBa, I tried to return multiple variables from an internal function to another function within the class.
If I have understood your above comment, then you are trying to use code outside of the local/module level. As per #Nathan_Sav comment above, declare everything publicly. See below.
Option Explicit
Public plen As Boolean ' PT length
Public numdash As Boolean ' numbers and dashes
Public titles As Boolean ' Tiles correct
Public Type checkResult
public status As Boolean
public errorp As String
End Type
Public Function CheckPTID(PTid As String) As checkResult
'initials
plen = False
numdash = False
titles = False
'Checks
If Len(PTid) = 8 Then plen = True
If InStr(PTid, "-") > -1 Then numdash = True
If (Left(PTid, 2) = "XP" Or Left(PTid, 2) = "XA") Then titles = True
'output
If (plen = False Or numbdash = False Or titles = False) Then
CheckPTID.status = False
If Not plen Then CheckPTID.errorp = "** Error Name length incorrect:" & PTid
If Not numdash Then CheckPTID.errorp = "** Error Name format incorrect:" & PTid
If Not titles Then CheckPTID.errorp = "** Error Name titles incorrect:" & PTid
Else
CheckPTID.status = True
CheckPTID.errorp = "N/A"
End If
End Function
Please let me know how this works for you as I have not tested it out! :)
Your narrative says: "I tried to return multiple variables from an internal function to another function within the class." . Thus I assume you want to use that Type (and CheckPTID() method too) inside your class only, i.e. you don't want to use that type in any other module.
Then declare Private that type and any other function inside your class that returns a variable of that type (like CheckPTID() does)
Furthermore you function has to be amended, since you have to:
initialize a variable of checkResult type by declaring it
Dim retCheckPTID As checkResult
use it throughout your sub to set its properties
retCheckPTID.status = False
If Not plen Then retCheckPTID.errorp = "** Error Name length incorrect: " & PTid
...
and finally set the return value of your function to it
CheckPTID = retCheckPTID
End Function
here comes the entire code:
Option Explicit
Private Type checkResult
status As Boolean
errorp As String
End Type
Private Function CheckPTID(PTid As String) As checkResult
Dim plen As Boolean ' PT length
Dim numdash As Boolean ' numbers and dashes
Dim titles As Boolean ' Tiles correct
Dim retCheckPTID As checkResult
' initials
plen = False
numdash = False
titles = False
' Checks
If Len(PTid) = 8 Then plen = True
If InStr(PTid, "-") > -1 Then numdash = True
If (Left(PTid, 2) = "XP" Or Left(PTid, 2) = "XA") Then titles = True
' output
If (plen = False Or numdash = False Or titles = False) Then
retCheckPTID.status = False
If Not plen Then retCheckPTID.errorp = "** Error Name length incorrect: " & PTid
If Not numdash Then retCheckPTID.errorp = "** Error Name format incorrect:" & PTid
If Not titles Then retCheckPTID.errorp = "** Error Name titles incorrect: " & PTid
Else
retCheckPTID.status = True
retCheckPTID.errorp = "N/A"
End If
CheckPTID = retCheckPTID
End Function
I am trying to create a excel chart using vb6. Instead of feeding a excel range im trying to feed an array. And im getting an error.
This is the code that im working on
Private Sub CreateChart(Optional ByVal ChartTitle As String _
, Optional ByVal xAxis As Excel.Range _
, Optional ByVal yAxis As Excel.Range _
, Optional ByVal ColumnName As String _
, Optional ByVal LegendPosition As XlLegendPosition = xlLegendPositionRight _
, Optional ByVal rowIndex As Long = 2 _
, Optional ByRef ChartType As String = xlLineMarkers _
, Optional ByVal PlotAreaColorIndex As Long = 2 _
, Optional ByVal isSetLegend As Boolean = False _
, Optional ByVal isSetLegendStyle As Boolean = False _
, Optional ByVal LegendStyleValue As Long = 1)
Const constChartLeft = 64
Const constChartHeight = 300
Const constChartWidth = 700
Dim xlChart As Excel.ChartObject
Dim seriesCount As Long
Dim ColorIndex As Long
Dim j As Long
With mWorksheet
.Rows(rowIndex).RowHeight = constChartHeight
Set xlChart = .ChartObjects.Add(.Rows(rowIndex).Left, .Rows(2).Top, constChartWidth, constChartHeight)
End With
With xlChart.chart
.ChartType = ChartType
.SetSourceData Source:=marrayPOClient, PlotBy:=marrayPOSKU
.SeriesCollection(1).XValues = marrayPOClient
.HasTitle = True
.Legend.Position = LegendPosition
.Legend.Font.Size = 7.3
.Legend.Font.Bold = True
.Legend.Border.LineStyle = xlNone
.ChartTitle.Characters.Text = ChartTitle
.ChartTitle.Font.Bold = True
.Axes(xlValue).TickLabels.Font.Size = 8 ' yAxis Labels
.Axes(xlCategory).TickLabels.Font.Size = 8 ' xAxis Labels
.PlotArea.Interior.ColorIndex = PlotAreaColorIndex
.PlotArea.Interior.ColorIndex = 15
.PlotArea.Interior.PatternColorIndex = 1
.PlotArea.Interior.Pattern = xlSolid
End With
End Sub
Is it possible to use array for chart. If possible what are my mistakes.
As Mat's Mug says, SetSourceData requires a Range, but you can achieve the result using another method
Replace
.SetSourceData Source:=marrayPOClient, PlotBy:=marrayPOSKU
with
.SeriesCollection.NewSeries
.SeriesCollection(1).Values = marrayPOClient
This will create a new series without a source, then assign the array as the series values
Chart.SetSourceData requires a Range object for its Source parameter, and an XlRowCol enum value for its PlotBy parameter.
I'm assuming both marrayPOClient and marrayPOSKU are arrays as their names imply (you haven't shown where they're declared and how they're assigned, so we can't know their type or value), but you need to supply a Range for the first parameter and, optionally, either xlColumns or xlRows for the second parameter.
Is there any reason why someone would set a DateTime variable equal to itself in Visual Basic like dtLocDate is in the code below?
Function ShouldBillingStart(ByVal sTheBillingType As String, _
ByRef bStartIt As Boolean, _
ByVal dtBillPeriod As DateTime) As Boolean
Dim bLocResult As Boolean
Dim dtFirstOfMonth As DateTime
Dim dtLocDate As DateTime
bLocResult = True
bStartIt = True
If bLocResult = True Then
If CInt(sTheBillingType) = gTheMasterPriceList.PricingType.PRICING_TYPE_DISCOUNTED Then
dtLocDate = dtLocDate
dtFirstOfMonth = CDate(Year(dtLocDate) & "/" & Month(dtLocDate) & "/1")
'add a month
dtFirstOfMonth = DateAdd(DateInterval.Month, 1, dtFirstOfMonth)
If Now < dtFirstOfMonth Then
bStartIt = False
End If
End If
End If
ShouldBillingStart = bLocResult
End Function
In short, no. This is just referencing itself. The Dim statement instantiates the Date object. Self referencing it wouldn't create the object though, nor set a default value.
This appears to serve no purpose.
Yeah, no reason at all. For example:
Dim This as String
This = "that"
This = This
Waste of time & resources...
I am trying to write a simple code that filters out data based on some condition.
My code is below :
Public Function fGetUniqInitiative(Optional ByVal uniqInitiative As Variant, Optional ByVal filter1 As Variant, Optional ByVal filter2 As Variant, Optional ByVal filter3 As Variant, Optional ByVal vartempData As Variant) As Variant()
Dim lngcounterinitiatve As Long
Dim lngVarData As Long
Dim lngfilter1 As Long
Dim lngfilter2 As Long
Dim lngfilter3 As Long
Dim boolfilter1 As Boolean
Dim boolfilter2 As Boolean
Dim boolfilter3 As Boolean
Dim varUniqueList() As Variant
Dim lnguniqueinitcount As Long
lnguniqueinitcount = 0
For lngcounterinitiative = LBound(uniqInitiative) To UBound(uniqInitiative)
boolfilter1 = False
boolfilter2 = False
boolfilter3 = False
For lngVarData = LBound(vartempData) To UBound(vartempData)
If uniqInitiative(lngcounterinitiative) = vartempData(lngVarData, 2) Then
For lngfilter1 = LBound(filter1) To UBound(filter1)
If vartempData(lngVarData, 9) = filter1(lngfilter1) Then
boolfilter1 = True
Exit For
End If
Next lngfilter1
For lngfilter2 = LBound(filter2) To UBound(filter2)
If vartempData(lngVarData, 10) = filter2(lngfilter2) Then
boolfilter2 = True
Exit For
End If
Next lngfilter2
For lngfilter3 = LBound(filter3) To UBound(filter3)
If vartempData(lngVarData, 11) = filter3(lngfilter3) Then
boolfilter3 = True
Exit For
End If
Next lngfilter3
If boolfilter1 = True Or boolfilter2 = True Or boolfilter3 = True Then
Exit For
Else
lnguniqueinitcount = lnguniqueinitcount + 1
ReDim varUniqueList(1 To lnguniqueinitcount)
End If
End If
Next lngVarData
Next lngcounterinitiatve
fGetUniqInitiative = varUniqueList
End Function
However, when i try to compile the code it gives the error "Invalid Next Control Variable reference". I have googled it quite a bit and all the solutions say that i must be missing closing the loop which i don't think is the case in my code. Anyone could point what am i missing?
lngcounterinitiative is spelled wrong in "Next lngcounterinitiatve".Try changing that.
I am attempting to do a VLOOKUP on a different worksheet based on given parameters in the function. I've played around with it for several hours and can not figure out why it is not working. I cut down the code as much as I could to test, but am unable to effectively find a solution. I think it might be an issue of how I am calling the range from the other worksheet for the VLOOKUP. Code is below. Please advice. If I'm unclear about what I'm asking just ask and I will provide feedback. Thank you
Function GraphDataA(cR As String, time As String, aClient As String, tps As String, dat As String)
Dim client As Boolean
Dim day As Boolean
Dim tot As Boolean
Dim dayTotData As Range
Dim dayTotDatas As Worksheet
Set dayTotDatas = ActiveWorkbook.Sheets("DayTot")
Set dayTotData = dayTotDatas.Range("A3:AI168")
client = False
day = False
tot = False
If date = "" Then
GraphDataA = ""
End If
If aClient = "" Then
GraphDataA = ""
End If
If cR = "Client" Then
client = True
End If
If time = "Day" Then
day = True
End If
If tps = "Total" Then
tot = True
End If
If client = True Then
If day = True Then
If tot = True Then
GraphDataA = WorksheetFunction.VLookup(aClient, dayTotData, WorksheetFunction.Match(dat, dayDate, 0) + 8, _
False)
End If
End If
End If
End Function
VLOOKUP() will throw an error if nothing matches. So you need to add error catching code to your function.
You need to modify the function as
Function MyFunction() as Something
On Error Goto ErrorHandler
' Your existing code goes here
Exit Function
ErrorHandler:
MyFunction = -1 ' Or something which indicates that the value isn't found
End Function
You don't appear to be returning any value from your function. Try adding As Variant to the end of the first line like so:
Function GraphDataA(cR As String, time As String, aClient As String, tps As String, dat As String) As Variant