Can you give me a hint on how to make such code more elegant?
I need some more of these queries in the future and I would like to do it more professionally.
Thank you!
If Case = "V" Then
Case Is = "Sal"
Else
If Case = "K" Then
Case Is = "Dep"
Else
If Case = "A" Then
Case Is = "Auf"
Else
If Case = "M" Then
Case Is = "Mon"
Else
If Case = "T" Then
Case Is = "Tec"
Else
If Case = "W" Then
Case Is = "Ver"
Else
If Case = "B" Then
Case Is = "Ber"
Else
If Case = "P" Then
Case Is = "Ver"
Else
GoTo GoNext
End If
End If
End If
End If
End If
End If
End If
End If
Use Select Case
Sub test()
Dim strCode As String
Dim strVal As String
strCode = "B"
Select Case strCode
Case "A"
strVal = "Jan"
Case "B"
strVal = "Feb"
Case "C"
strVal = "Mar"
Case Else
strVal = "No match found"
End Select
End Sub
Using Select Case ... End Select
But you need to declare a variable, let us say x to be the reference
Dim x as String, y as String
'Allocate value to the `x` variable. In any way. Then:
Select Case x
Case "V": y = "Sal"
Case "K": y = "Dep"
Case "A": y = "Auf"
' and so on...
Case Else: y = "Whatever..."
End Select
Finally you obtain the y value according to the x one...
As usual, multiple ifs are simplified into one dictionary / hash table / object .
Dim variablename
Set variablename = CreateObject("Scripting.Dictionary")
variablename.Add ("V", "Sal")
variablename.Add ("K", "Dep")
....
variablename.Add ("P", "Var")
Get the variable as follows
ans = 'Nothing'
if variablename.exists("P") then
ans = variablename("P")
Rem ans = variablename.item("P") ?
Rem Equals "Var"
end if
see also https://excelmacromastery.com/vba-dictionary/
What about the following:
If Case = "V" Then
ElseIf Case = "K" Then
ElseIf Case = "A" Then
...
End If
Related
With the following global variables:
Dim SpilleBræt(8, 8) As PictureBox
Dim Position(8, 8) As String
Dim MarkeretFelt(8, 8) As String
Dim FeltFarve As String
Dim x As Integer
Dim y As Integer
Dim AktivMarkering As Boolean = 0
Dim SpilleBrik As String
And this code:
Private Sub PictureBox_Click(ByVal sender As Object, ByVal e As EventArgs)
Dim FeltValg As PictureBox = CType(sender, PictureBox)
If AktivMarkering = 1 Then
x = Mid(sender.name, sender.name.Length - 1, 1)
y = Mid(sender.name, sender.name.Length, 1)
Select Case Position(y, x)
Case "LightTileMarked"
Me.SpilleBræt(y, x).BackgroundImage = My.Resources.ResourceManager.GetObject(SpilleBrik & "LightTile")
Case "DarkTileMarked"
Me.SpilleBræt(y, x).BackgroundImage = My.Resources.ResourceManager.GetObject(SpilleBrik & "DarkTile")
Case Else
'fjerner markerede
Select Case Position(y, x)
Case "BlackTower", "WhiteTower"
MsgBox("Tårn")
Case "BlackHorse", "WhiteHorse"
MsgBox("Hest")
Case "BlackBishop", "WhiteBishop"
MsgBox("Løber")
Case "WhiteKing", "BlackKing"
MsgBox("Konge")
Case "WhiteQueen", "BlackQueen"
MsgBox("Dronning")
Case "WhitePawn", "BlackPawn"
For k As Integer = y To 1 Step -1
If Position(k, x) = "" Then
If (k + x) Mod 2 = 1 Then
FeltFarve = "DarkTile"
Else
FeltFarve = "LightTile"
End If
Me.SpilleBræt(x, k).BackgroundImage = My.Resources.ResourceManager.GetObject(FeltFarve)
ElseIf Position(k, x) = "WhitePawn" Or Position(k, x) = "BlackPawn" Then
'background død brik
Else
k = 1
End If
Next
End Select
End Select
Else
'indsætter markering
'x,y i picturebox'ens navn fx ->(SpilBrik44) hvor x=4 og y=4
x = Mid(sender.name, sender.name.Length - 1, 1)
y = Mid(sender.name, sender.name.Length, 1)
Select Case Position(y, x)
Case "BlackTower", "WhiteTower"
MsgBox("Tårn")
Case "BlackHorse", "WhiteHorse"
MsgBox("Hest")
Case "BlackBishop", "WhiteBishop"
MsgBox("Løber")
Case "WhiteKing", "BlackKing"
MsgBox("Konge")
Case "WhiteQueen", "BlackQueen"
MsgBox("Dronning")
Case "WhitePawn", "BlackPawn"
For k As Integer = y To 1 Step -1
If Position(k, x) = "" Then
If (k + x) Mod 2 = 1 Then
FeltFarve = "DarkTileMarked"
Else
FeltFarve = "LightTileMarked"
End If
Me.SpilleBræt(x, k).BackgroundImage = My.Resources.ResourceManager.GetObject(FeltFarve)
MarkeretFelt(x, k) = FeltFarve
AktivMarkering = 1
ElseIf Position(k, x) = "WhitePawn" Or Position(k, x) = "BlackPawn" Then
'background død brik
Else
k = 1
End If
Next
End Select
End If
End Sub
I have a problem with the first If statement aktivmarkering=1, goes directly to the 'Else' even though if statements is true.
First time code is run, aktivmarkering is = 0, and therefore it obviously goes to 'Else', but after that one has ben run AktivMarkering is = 1, and first if should be executed. I don't see why not - anyone whos able to help?
Thanks.
I'm trying to check if the column headers are in their right positions ( I have declared the actual column headers as constant values) and if they are not move them around to their right positions.
I'm new to VBA and when I tried it out with the basic For loop and Select Case, I realised the code was too long. I was thinking if there is another perhaps a simpler way to do it.
Below is a sample of the code I tried:
Sheet4_Last_RowNum = WorkingSheet.Cells(Rows.Count, 1).End(xlUp).Row
Sheet4_Last_ColNum = WorkingSheet.Cells(Label_RowNum, Columns.Count).End(xlToLeft).Column
For icol = 1 To Sheet4_Last_ColNum
Select Case WorkingSheet.Cells(Label_RowNum, icol).Value
Case "WkVersion"
Sheet4_WkCol = icol
If Sheet4_WkCol <> Sheet4_ActualWk Then
Sheet4_WkValue = WorkingSheet.Range(Cells(headerRow, Sheet4_WkCol), Cells(Sheet4_Last_RowNum, Sheet4_WkCol))
End If
Case "MPA"
Sheet4_MPACol = icol
If Sheet4_MPACol <> Sheet4_ActualMPA Then
Sheet4_MPAValue = WorkingSheet.Range(Cells(headerRow, Sheet4_MPACol), Cells(Sheet4_Last_RowNum, Sheet4_MPACol))
End If
Case "Location"
Sheet4_LocCol = icol
If Sheet4_LocCol <> Sheet4_ActualLoc Then
Sheet4_LocValue = WorkingSheet.Range(Cells(headerRow, Sheet4_LocCol), Cells(Sheet4_Last_RowNum, Sheet4_LocCol))
End If
End Select
Next icol
With WorkingSheet
If IsEmpty(Sheet4_WkValue) = True Then
Else
.Range(Cells(headerRow, Sheet4_ActualWk), Cells(Sheet4_Last_RowNum, Sheet4_ActualWk)) = Sheet4_WkValue
End If
If IsEmpty(Sheet4_MPAValue) = True Then
Else
.Range(Cells(headerRow, Sheet4_ActualMPA), Cells(Sheet4_Last_RowNum, Sheet4_ActualMPA)) = Sheet4_MPAValue
End If
If IsEmpty(Sheet4_LocValue) = True Then
Else
.Range(Cells(headerRow, Sheet4_ActualLoc), Cells(Sheet4_Last_RowNum, Sheet4_ActualLoc)) = Sheet4_LocValue
End If
End With
I'm making a vba project with some userforms. I want the people to click the macro button, then need to choose their initials, then by togglebutton click the weeks they want to go on holiday and then click transfer. So far i've done, that if they click one their initials, the value will be printed to a cell. The next userform (userform2), will need to look for the value, to determin wich row the values will be printed in.
But i get an error, on my Select case code.
Private Sub CommandButton1_Click()
Dim score As Integer, result As String
score = ActiveSheet.Range("A19").Value
Select Case score
Case Is = "CTK"
result = Something
Case Is = "MogM"
result = Something1
Case Is = "KSJI"
result = Something2
Case Is = "TSLR"
result = Something3
Case Is = "JOHQ"
result = Something4
Case Is = "OLGJ"
result = Something5
Case Is = "CBJN"
result = Something6
Case Is = "JVLK"
result = Something7
Case Is = "JFP"
result = Something8
Case Is = "EVAD"
result = Something9
Case Is = "TKUP"
result = Something10
Case Else
MsgBox ("Didn't find anyone with these init")
Range("A20").Value = result
End Select
End Sub
Private Sub ToggleButton1_Click()
End Sub
I solved the coding, but now i got a new question. Is it possible to simplify it?
Private Sub CommandButton1_Click()
Dim score As Integer, result As String
score = ActiveSheet.Range("A19").Value
Select Case score
Case Is = "1"
result = "CTK"
Case Is = "2"
result = "MogM"
Case Is = "3"
result = "KSJI"
Case Is = "4"
result = "TSLR"
Case Is = "5"
result = "JOHQ"
Case Is = "6"
result = "OLGJ"
Case Is = "7"
result = "CBJN"
Case Is = "8"
result = "JVLK"
Case Is = "9"
result = "JFP"
Case Is = "10"
result = "EVAD"
Case Is = "11"
result = "TKUP"
Case Else
MsgBox ("Didn't find anyone with these init")
End Select
Range("A20").Value = result
'CTK opportunities
If result = "CTK" And ToggleButton1 = True Then Range("B4").Value = "X"
If result = "CTK" And ToggleButton2 = True Then Range("C4").Value = "X"
If result = "CTK" And ToggleButton3 = True Then Range("D4").Value = "X"
If result = "CTK" And ToggleButton4 = True Then Range("E4").Value = "X"
If result = "CTK" And ToggleButton5 = True Then Range("F4").Value = "X"
If result = "CTK" And ToggleButton6 = True Then Range("G4").Value = "X"
If result = "CTK" And ToggleButton7 = True Then Range("H4").Value = "X"
If result = "CTK" And ToggleButton8 = True Then Range("I4").Value = "X"
If result = "CTK" And ToggleButton9 = True Then Range("J4").Value = "X"
If result = "CTK" And ToggleButton10 = True Then Range("K4").Value = "X"
If result = "CTK" And ToggleButton11 = True Then Range("L4").Value = "X"
If result = "CTK" And ToggleButton12 = True Then Range("M4").Value = "X"
'Next person
Unload Me
End Sub
I am trying to create a custom function that basically does this:
The function is in column F and looks at column C to see what the valus is in there.
If it is USA_USD it will display USD in colomn F
If it is Australia_AUD the it will display AUD in colomn F
etc.
Function The_Decider(DealCurrency, X)
If DealCurrency = "USA_USD" Then X = "USD"
Else
If DealCurrency = "Australia_AUD" Then X = "AUD"
Else
If DealCurrency = "Switzerland_CHF" Then X = "CHF"
Else
If DealCurrency = "China_CNY" Then X = "CNY"
Else
If DealCurrency = "EMU_EUR" Then X = "EUR"
Else
If DealCurrency = "Great Britain_GBP" Then X = "GBP"
Else
If DealCurrency = "Hong Kong_HKD" Then X = "HKD"
Else
If DealCurrency = "Japan_JPY" Then X = "JPY"
Else
If DealCurrency = "Korea(South)_KRW" Then X = "KRW"
Else
If DealCurrency = "Viet Nam_VND" Then X = "VND"
End Function
Why I am getting #value in column C?
First of all, you don't actually supply a return value at any point. Also you would probably be better going for a Select Case block for the sake of readability.
You should declare the return type in the function header, then use the same name as the function to return the value in your code:
Function The_Decider(ByVal DealCurrency As String) As String '// <~~ return type
Dim X As String
Select Case DealCurrency
Case "USA_USD": X = "USD"
Case "Australia_AUD": X = "AUD"
Case "Switzerland_CHF": X = "CHF"
Case "China_CNY": X = "CNY"
Case "EMU_EUR": X = "EUR"
Case "Great Britain_GBP": X = "GBP"
Case "Hong Kong_HKD": X = "HKD"
Case "Japan_JPY": X = "JPY"
Case "Korea(South)_KRW": X = "KRW"
Case "Viet Nam_VND": X = "VND"
Case Else: X = "Unknown"
End Select
The_Decider = X '// <~~ the part that actually returns the value
End Function
Although seeing as your input appears to have the currency code in the last 3 letters, I wouldn't even use a UDF. Simply using a worksheet formula would suffice:
=RIGHT(C1,3)
I am trying to convert a number to a word from a RDLC report:
Public Shared Function changeToWords(ByVal numb As [String]) As [String]
Dim val As [String] = ""
Dim wholeNo As [String] = numb
Dim points As [String] = ""
Dim andStr As [String] = ""
Dim pointStr As [String] = ""
Dim endStr As [String] = ""
Try
Dim decimalPlace As Integer = numb.IndexOf(".")
If decimalPlace > 0 Then
wholeNo = numb.Substring(0, decimalPlace)
points = numb.Substring(decimalPlace + 1)
If Convert.ToInt32(points) > 0 Then
andStr = "point"
' just to separate whole numbers from points
pointStr = translateCents(points)
End If
End If
val = [String].Format("{0} {1}{2} {3}", translateWholeNumber(wholeNo).Trim(), andStr, pointStr, endStr)
Catch
End Try
Return val
End Function
Private Shared Function translateWholeNumber(ByVal number As [String]) As [String]
Dim word As String = ""
Try
Dim beginsZero As Boolean = False
'tests for 0XX
Dim isDone As Boolean = False
'test if already translated
Dim dblAmt As Double = (Convert.ToDouble(number))
'if ((dblAmt > 0) && number.StartsWith("0"))
If dblAmt > 0 Then
'test for zero or digit zero in a nuemric
beginsZero = number.StartsWith("0")
Dim numDigits As Integer = number.Length
Dim pos As Integer = 0
'store digit grouping
Dim place As [String] = ""
'digit grouping name:hundres,thousand,etc...
Select Case numDigits
Case 1
'ones' range
word = ones(number)
isDone = True
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 2
'tens' range
word = tens(number)
isDone = True
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 3
'hundreds' range
pos = (numDigits Mod 3) + 1
place = " Hundred "
Exit Select
' TODO: might not be correct. Was : Exit Select
'thousands' range
Case 4, 5, 6
pos = (numDigits Mod 4) + 1
place = " Thousand "
Exit Select
' TODO: might not be correct. Was : Exit Select
'millions' range
Case 7, 8, 9
pos = (numDigits Mod 7) + 1
place = " Million "
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 10
'Billions's range
pos = (numDigits Mod 10) + 1
place = " Billion "
Exit Select
Case Else
' TODO: might not be correct. Was : Exit Select
'add extra case options for anything above Billion...
isDone = True
Exit Select
' TODO: might not be correct. Was : Exit Select
End Select
If Not isDone Then
'if transalation is not done, continue...(Recursion comes in now!!)
word = translateWholeNumber(number.Substring(0, pos)) + place + translateWholeNumber(number.Substring(pos))
'check for trailing zeros
If beginsZero Then
word = " and " & word.Trim()
End If
End If
'ignore digit grouping names
If word.Trim().Equals(place.Trim()) Then
word = ""
End If
End If
Catch
End Try
Return word.Trim()
End Function
Private Shared Function tens(ByVal digit As [String]) As [String]
Dim digt As Integer = Convert.ToInt32(digit)
Dim name As [String] = Nothing
Select Case digt
Case 10
name = "Ten"
Exit Select
' TODO: might not be correct. Was : Exit Select \
Case 11
name = "Eleven"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 12
name = "Twelve"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 13
name = "Thirteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 14
name = "Fourteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 15
name = "Fifteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 16
name = "Sixteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 17
name = "Seventeen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 18
name = "Eighteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 19
name = "Nineteen"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 20
name = "Twenty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 30
name = "Thirty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 40
name = "Fourty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 50
name = "Fifty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 60
name = "Sixty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 70
name = "Seventy"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 80
name = "Eighty"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 90
name = "Ninety"
Exit Select
Case Else
' TODO: might not be correct. Was : Exit Select
If digt > 0 Then
name = (Convert.ToString(tens(digit.Substring(0, 1) & "0")) & " ") & Convert.ToString(ones(digit.Substring(1)))
End If
Exit Select
' TODO: might not be correct. Was : Exit Select
End Select
Return name
End Function
Private Shared Function ones(ByVal digit As [String]) As [String]
Dim digt As Integer = Convert.ToInt32(digit)
Dim name As [String] = ""
Select Case digt
Case 1
name = "One"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 2
name = "Two"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 3
name = "Three"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 4
name = "Four"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 5
name = "Five"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 6
name = "Six"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 7
name = "Seven"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 8
name = "Eight"
Exit Select
' TODO: might not be correct. Was : Exit Select
Case 9
name = "Nine"
Exit Select
' TODO: might not be correct. Was : Exit Select
End Select
Return name
End Function
Private Shared Function translateCents(ByVal cents As [String]) As [String]
Dim cts As [String] = ""
Dim digit As [String] = ""
Dim engOne As [String] = ""
For i As Integer = 0 To cents.Length - 1
digit = cents(i).ToString()
If digit.Equals("0") Then
engOne = "Zero"
Else
engOne = ones(digit)
End If
cts += " " & engOne
Next
Return cts
End Function
I am getting the wrong output from the conversion.
For 52001 the given output is Fifty Two Thousand and Hundred One.
However, it should be Fifty Two Thousand and One.
You'll need to add a conditional statement to modify your string concatenation behavior when the beginning of your substring is a zero.
'if transalation is not done, continue...(Recursion comes in now!!)
If (number.Substring(0, 1) = "0") Then
word = translateWholeNumber(number.Substring(pos))
Else
word = translateWholeNumber(number.Substring(0, pos)) + place + translateWholeNumber(number.Substring(pos))
End If
Edit: Doing this breaks output if the original string sent to changeToWords begins with any zeros. To rectify that condition, you can trim leading zeros, before the string is processed:
Dim wholeNo As [String] = numb.TrimStart("0"c)
Just change this line:
If Not isDone Then
'if transalation is not done, continue...(Recursion comes in now!!)
word = translateWholeNumber(number.Substring(0, pos)) + place + translateWholeNumber(number.Substring(pos))
'check for trailing zeros
If beginsZero Then
word = translateWholeNumber(number.Substring(0, pos))+ " and " + translateWholeNumber(number.Substring(pos))
End If
End If