I have a class ("Names"):
Option Explicit
Public companyName As String
Public companyCode As String
Public companyCountry As String
Property Get fullInfo() As String
fullInfo = "Code " & companyCode & " is " & companyCountry & " for " & companyName
End Property
and in a Sub() in a Module, I have the following:
Sub classTest()
Dim c1 As New Names
Dim c2 As New Names
c1.companyCode = 14
c1.companyCountry = "Ivory Coast"
c1.companyName = "Ivory Company"
c2.companyCode = 11
c2.companyCountry = "Cameroon"
c2.companyName = "Cameroon Company"
Dim i As Integer
debug.print c1.fullInfo
End Sub
This correctly will print "Code 14 is Ivory Coast for Ivory Company".
How can I write a loop to go through ALL the properties (is that the right word? is c1, c2, a 'property'?). I tried something like below, but it didn't work:
for i = 1 to 2
debug.print ci.fullInfo
next i
You can see that it obviously won't work - but how can I get it to do so? Sorry, I don't know what the c1 part is called, nor what's the part after the . is called)
If you store c1,c2,etc in an array or collection then you can loop over them using a standard For loop and call fullInfo for each of them.
Sub Tester()
Dim col As New Collection, n As Names, i
For i = 1 To 10
Set n = New Names
n.companyCode = i
n.companyCountry = "Country_" & i
n.companyName = "Company_" & i
col.Add n
Next i
For Each n In col
Debug.Print n.fullInfo
Next n
End Sub
Look at a for each loop. Something like
For Each variable_name In collection_name
'Some code here.
Next variable_name
Related
I'm having an issue trying to create a program that takes user input for a text file's location containing medical records. The diseases and number of patients are being added to a list. I'm having an issue where my console is printing 0 for both the total of XX unique diseases and YYY patient encounters. I am not getting any errors, just not the correct output.
I believe my issue is in my processData() sub, however I am unsure why it's printing back 0. Also, how do I go about keeping track of duplicate diseases that are added to the list as I'm trying to add a counter next to each time the disease is seen.
Sample from Disease.txt
3710079 JUDITH CLOUTIER 2012-08-04 Spastic Colonitis
3680080 VIRGINIA ALMOND 2012-07-25 Chronic Phlegm
3660068 ELLEN ENGLEHARDT 2012-04-06 Whooping Cough
3810076 LILLIAN KEMMER 2014-07-04 Scurvy
3630055 TERESA BANASZAK 2012-06-15 Scurvy
Output:
There were a total of 0 unique diseases observed.
A total of 0 patient encounters were held
Main():
' Global variables
Dim inputFile As String
Dim patientCounter = 0
Dim diseaseList As New List(Of String)
Dim dateList As New List(Of Date)
Sub Main()
Dim reportFile As String
Dim yn As String
Console.ForegroundColor = ConsoleColor.Yellow
Console.BackgroundColor = ConsoleColor.Blue
Console.Title = "Medical Practice Data Analysis Application"
Console.Clear()
Console.WriteLine("Please enter the path and name of the file to process:")
inputFile = Console.ReadLine
If (File.Exists(inputFile)) Then
' Call to processData sub if input file exists
processData()
Console.WriteLine(vbCrLf & "Processing Completed...")
Console.WriteLine(vbCrLf & "Please enter the path and name of the report file to generate")
reportFile = Console.ReadLine
File.Create(reportFile).Dispose()
If (File.Exists(reportFile)) Then
Console.WriteLine(vbCrLf & "Report File Generation Completed...")
Else
' Call to sub to end program if directory does not exist
closeProgram()
End If
' Get user input to see report
Console.WriteLine(vbCrLf & "Would you like to see the report file [Y/n]")
yn = Console.ReadLine
' If user inputs "y" or "Y" then print report
' Otherwise close the program
If (yn = "y" OrElse "Y") Then
printFile()
Else
closeProgram()
End If
Else
' Call to sub to end program if file does not exist
closeProgram()
End If
Console.ReadLine()
End Sub
processData Sub():
Public Sub processData()
Dim lines As String() = File.ReadAllLines(inputFile)
Dim tab
Dim dates
Dim diseaseCounter = 0
For Each line As String In lines
tab = line.Split(vbTab)
patientCounter += 1
dates = Date.Parse(line(3))
dateList.Add(dates)
'diseaseList.Add(line(4))
Dim disease As New disease(line(4))
diseaseList.Add(disease.ToString)
'diseaseList(line(4)).
For Each value In diseaseList
'If value.Equals(line(4)) Then disease.counter += 1
Next
Next
Dim uniqueDiseases As String() = diseaseList.Distinct().ToArray
End Sub
Disease.class
Class disease
Dim counter As Integer = 0
Dim name As String = ""
Sub New(newDisease As String)
name = newDisease
counter = 0
End Sub
End Class
printFile()
Sub printFile()
Dim muchoMedical As String = "MuchoMedical Health Center"
Dim diseaseReport As String = "Disease Report For the Period " & "earliest_date" & " through " & "latest_date"
Console.WriteLine(vbCrLf & muchoMedical.PadLeft(Console.WindowWidth / 2))
Console.WriteLine(diseaseReport.PadLeft(Console.WindowWidth / 2))
Console.WriteLine(vbCrLf & "There were a total of " & diseaseList.Count & " unique diseases observed")
Console.WriteLine("A total of " & patientCounter & " patient encounters were held")
Console.WriteLine(vbCrLf & "Relative Histogram of each disease")
For Each disease As String In diseaseList
Console.WriteLine(vbCrLf & disease & vbTab & " ")
Next
End Sub
closeProgram()
Sub closeProgram()
Console.WriteLine(vbCrLf & "File does not exist")
Console.WriteLine("Press Enter to exit the program...")
Console.ReadLine()
End Sub
You don't need a disease class, really, if the most complicated thing you are doing is counting disease occurrences (your disease class had no public members so I don't know what you were doing there anyway). You can simply do everything with a little LINQ.
' processing section
Dim lines = File.ReadAllLines(inputFile)
Dim splitLines = lines.Select(Function(l) l.Split({vbTab}, StringSplitOptions.RemoveEmptyEntries))
Dim diseaseGrouping = splitLines.GroupBy(Function(s) s(3))
Dim patients = splitLines.Select(Function(s) s(1))
Dim dates = splitLines.Select(Function(s) DateTime.Parse(s(2)))
' report section
Dim padAmount = CInt(Console.WindowWidth / 2)
Dim muchoMedical As String = "MuchoMedical Health Center"
Dim diseaseReport As String = $"Disease Report For the Period {dates.Min():d} through {dates.Max():d}"
Console.WriteLine()
Console.WriteLine(muchoMedical.PadLeft(padAmount))
Console.WriteLine(diseaseReport.PadLeft(padAmount))
Console.WriteLine()
Console.WriteLine($"There were a total of {diseaseGrouping.Count()} unique diseases observed.")
Console.WriteLine($"A total of {patients.Count()} patient encounters were held")
For Each diseaseAndCount In diseaseGrouping
Console.WriteLine()
Console.WriteLine($"{diseaseAndCount.Key}{vbTab}{diseaseAndCount.Count()}")
Next
I think your disease name is in index 3. You were looking at 4 originally. Maybe you have a tab between first and last name? Change it if I was wrong. This may apply to any or all of the indices.
Output:
MuchoMedical Health Center
Disease Report For the Period 4/6/2012 through 7/4/2014
There were a total of 4 unique diseases observed.
A total of 5 patient encounters were held
Spastic Colonitis 1
Chronic Phlegm 1
Whooping Cough 1
Scurvy 2
I think the main issue with your code as listed above is that in the processData sub you have:
For Each line As String In lines
tab = line.Split(vbTab)
patientCounter += 1
dates = Date.Parse(line(3))
dateList.Add(dates)
'diseaseList.Add(line(4))
Dim disease As New disease(line(4))
diseaseList.Add(disease.ToString)
'diseaseList(line(4)).
For Each value In diseaseList
'If value.Equals(line(4)) Then disease.counter += 1
Next
Next
I think you more likely mean to use tab(3) and tab(4) instead of line(3) and line(4) etc. You split the line into the "tab" variable but then don't use it. While you could rewrite everything and handle it differently, if you want to go with what you've got, I think that's your core error.
I liked your idea of a class. You can wrap up all your data in one list. I enhanced your class so it could contain all the data in the file. Public Properties are automatic properties that have Get, Set, and the Private fields that hold the data written by the compiler. I have added an Overrides of the .ToString because you were not getting the results you expected. We have the parameterized constructor like you have except expanded to include all the properties.
The magic comes in the Linq query. The d stands for an item in the diseaseList which is an instance of the Disease class. Then I added an order by clause which will produce the results in alphabetical order by DiseaseName which is a string. Grouping by the unique DiseaseName into a Group with Count.
Notice in the second For Each loop we have all the properties of the class available.
I happened to be in a Windows Forms app so I used Debug.Print. Just replace with Console.WriteLine. I leave to you the fancy formatting if you desire.
Public Class Disease
Public Property Name As String
Public Property DiagnosisDate As Date
Public Property DiseaseName As String
Public Property ID As Integer
Public Sub New(PatientID As Integer, PatientName As String, dDate As Date, sDisease As String)
ID = PatientID
Name = PatientName
DiagnosisDate = dDate
DiseaseName = sDisease
End Sub
'If you don't override ToString you will get the fully qualified name of the class
'You can return any combination of the Properties as long as the end
'result is a string
Public Overrides Function ToString() As String
Return Name
End Function
End Class
Public Sub processData()
Dim lines As String() = File.ReadAllLines(inputFile)
Dim diseaseList As New List(Of Disease)
For Each line As String In lines
'I was having trouble with the tabs so I changed it to a comma in the file
'3710079,JUDITH CLOUTIER,2012-08-04,Spastic Colonitis
'the small c following the "," tells the compiler that this is a Char
Dim tab = line.Split(","c)
Dim inputDate = Date.ParseExact(tab(2), "yyyy-MM-dd", CultureInfo.InvariantCulture)
Dim Studentdisease As New Disease(CInt(tab(0)), tab(1), inputDate, tab(3))
diseaseList.Add(Studentdisease)
Next
Dim diseaseGrouping = From d In diseaseList
Order By d.DiseaseName
Group By d.DiseaseName
Into Group, Count
For Each diseaseAndCount In diseaseGrouping
Debug.Print($"{diseaseAndCount.DiseaseName} {diseaseAndCount.Count()} ")
For Each d In diseaseAndCount.Group
Debug.Print($" {d.Name}, {d.DiagnosisDate.ToShortDateString}")
Next
Next
End Sub
I have a line of code in one module:
City = "Paris"
Within a separate module I need to change the name of the city based on what a user selects from a dropdown. I have code that will change the entire line as follows:
Sub ChangeUserCity()
Call Dictionary.CityLocation
Dim UserChosenCity As String
Dim SL As Long, EL As Long, SC As Long, EC As Long
Dim S As String
Dim Found As Boolean
ComboBoxList = Array(CStr(CityName)) 'This is the name of the combodropdown box with the list of city names.
For Each Ky In ComboBoxList
'On Error Resume Next
UserChosenCity = dict4.Item(Ky)(0) 'This refers to the dictionary that has the list of city names. It grabs the string (the name of the city).
With ActivePresentation.VBProject.VBComponents("Dictionary").CodeModule
SL = 1
SC = 1
EL = -1
EC = -1
Found = .Find("City = " & """" & "Paris" & """", SL, SC, EL, EC, True, False, False)
If Found = True Then
S = .Lines(SL, 1)
S = Replace(S, "City = " & """" & "Paris" & """", "City= " & """" & UserChosenCity & """")
.ReplaceLine SL, S
End If
End With
Next Ky
End Sub
The problem with the way this code works is that the city name will not always be "Paris". It could be any string (i.e. any city name). So what I really need the code to do is just replace the city name between the quotes with the UserChosenCity. Any idea on how to accomplish this? Thank you!
Add a combo box and a text box to your slide.
With ComboBox1 and TextBox1 on Slide 1 this code moves the value from the combobox to the the textbox:
Private Sub ComboBox1_Change()
Dim oComboBox As ComboBox
Dim oTextBox As TextBox
Set oComboBox = ActivePresentation.Slides("Slide1").Shapes("ComboBox1").OLEFormat.Object
Set oTextBox = ActivePresentation.Slides("Slide1").Shapes("TextBox1").OLEFormat.Object
oTextBox.Value = oComboBox.Value
'or
Slide1.TextBox1.Value = Slide1.ComboBox1.Value
End Sub
Note: Powerpoint isn't my forte so there may be a "proper" way to store values in PPT.
You can now retrieve the value from the textbox after the presentation has been saved, closed and re-opened (saying that - the combobox also retained the value when I re-opened it) and use that value in elsewhere in your code.
Is it possible to:
Access a list of all variables in a VBA runtime environment?
Access the name of a variable with VBA?
Example:
function v2S(str as string) as string
For each variable in Variables
dim I as integer
for I = 1 to 10
v2S = replace(v2S,"%" & variable.name & "%", variable.value)
next
next
end function
Example use case:
Dim skyColor as string
skyColor = "green"
Debug.Print v2S("The sky is %skyColor% today!")
There is an application I can send commands to via a com object and I wish to do something along the lines of:
Dim i a integer
for i = 1 to MI.Eval("numtables()")
MI = GetObject(,"MapInfo.Application.x64")
debug.print MI.Eval(v2S("tableinfo(%i%,1)")) ' Print name of table
next
The above looks much cleaner than:
Dim i a integer
for i = 1 to MI.Eval("numtables()")
MI = GetObject(,"MapInfo.Application.x64")
debug.print MI.Eval(v2S("tableinfo(" & i & ",1)")) ' Print name of table
next
But of course if it were possible I would want it to be general which may be difficult...
For my own use case this is pretty good.
However it still isn't very readable. This is another option. It's more readable but also more cluttered:
Sub Main()
Dim Vars as object, myString as string
set Vars = CreateObject("scripting.Dictionary")
Vars.add "Var1","Val1"
Vars.add "Var2","Val2"
'...
myString = r("Var1: #{Var1} and Var2: #{Var2}", Vars)
End Sub
function r(byval s as string, byval o as object) as string
for each key in o.keys
s = replace(s,"#{" & key & "}",o.item(key))
next
r = s
end function
I wish string interpolation functionality existed by default in VBA.
Working in Excel VBA, I have a class module where I define my class 'Marker'. One of the properties of my class is TextLine(), which is an array that holds up to 5 strings. I have defined the two methods below in my class module. In another (regular) module, I fill markerArr() with my custom Marker objects. Loading each object's properties with data at each array index is working fine... However, after loading data into the object at each index, I try to use markerArr(count).ProcessLines but receive a type mismatch error. Since ProcessLines is a public sub in my class module, and markerArr(count) contains a Marker object, I can't seem to understand why this error is occurring... Am I overlooking something obvious?
'Serial number replacement processing function
Public Sub ProcessLines()
Dim strSerial As String
Dim toggle As Boolean
toggle = False
Dim i As Integer
For i = 0 To 4
If Trim(m_TxtLines(i)) <> "" Then
'Add linefeed char to non-empty text lines
m_TxtLines(i) = m_TxtLines(i) & Chr(10)
'Detect if it is a serialized line
If InStr(1, m_TxtLines(i), "XXXXXX-YYY") > 0 Then
m_Serial(i) = True
toggle = True
End If
End If
Next
'When at least one line on the marker is serialized, create and replace serial text
If toggle = True Then
'Only prompt for input once
If startSerNo < 1 And Num_Sers < 1 Then
startSerNo = InputBox("Enter the serial number to start printing at." & Chr(10) & _
"Entering 1 will result in -001, entering 12 will result in -012, etc.", "Starting Serial #", "1")
Num_Sers = InputBox("Enter the amount of serializations to perform." & Chr(10) & _
"This will control how many copies of the entire marker set are printed.", "Total Serializations", "1")
End If
strSerial = CreateSerial(startSerNo)
Dim j As Integer
For j = 0 To 4
If m_Serial(j) Then
m_TxtLines(j) = Replace(m_TxtLines(j), "XXXXXX-YYY", strSerial)
End If
Next
End If
End Sub
'Creates the string to replace XXXXXX-YYY by concatenating the SFC# with the starting serial number
Private Function CreateSerial(ByVal startNum As Integer)
Dim temp
temp = SFC_Num
Select Case Len(CStr(startNum))
Case 1
temp = temp & "-00" & startNum
Case 2
temp = temp & "-0" & startNum
Case 3
temp = temp & "-" & startNum
Case Else
temp = temp & "-001"
End Select
CreateSerial = temp
End Function
Your CreateSerial function takes an integer as a parameter, but you are attempting to pass a string. I've pointed out some problems:
If startSerNo < 1 And Num_Sers < 1 Then 'Here I assume, you have these semi-globals as a variant - you are using numeric comparison here
startSerNo = InputBox("Enter the serial number to start printing at." & Chr(10) & _
"Entering 1 will result in -001, entering 12 will result in -012, etc.", "Starting Serial #", "1") 'Here startSerNo is returned as a string from the inputbox
Num_Sers = InputBox("Enter the amount of serializations to perform." & Chr(10) & _
"This will control how many copies of the entire marker set are printed.", "Total Serializations", "1") 'here Num_Sers becomes a String too
End If
strSerial = CreateSerial(startSerNo) 'here you are passing a String to the CreateSerial function. Either pass an integer, or allow a variant as parameter to CreateSerial
'......more code.....
Private Function CreateSerial(ByVal startNum As Integer)
In Excel 2010, using VBA, how can I breakapart a string when it finds a certain character?
Let say A1 = "This is a | test of | the | emergency broadcast signal"
And I assign that to a variable like
strColumnA = Range("A" & CStr(currRow)).Value
Now I want to append 4 new rows at the end of worksheet 2. All Column A, like:
A1 = "This is a"
A2 = "test of"
A3 = "the"
A4 = "emergency broadcast signal"
Any ideas?
Use this as there is no need for a loop, also it is important to leave the Application.Trim() in:
Sub test()
Dim r As Variant, s As String
s = [a1].Value
r = Split(Application.Trim(s), "|")
[b1].Resize(UBound(r, 1) + 1) = Application.Transpose(r)
End Sub
Use Split()
Sub Sample()
Dim Ret
Dim strColumnA As String
Dim i As Long
strColumnA = "This is a | test of | the | emergency broadcast signal"
Ret = Split(strColumnA, "|")
For i = LBound(Ret) To UBound(Ret)
Debug.Print Ret(i)
Next i
End Sub