i have a string containing special characters ('★☆☽☾☁') and i would like to have ★ printed out for monday, ☆ for tuesday, ☽ for wednesday, ☾ for thursday, and ☁ for friday. i apologize since i am very new to vb.net so i have only very basic knowledge about it. i have already tried this:
Dim today As Date = Date.Today
Dim dayIndex As Integer = today.DayOfWeek
Dim specialcharacters() As Char = "★☆☽☾☁"
If dayIndex < DayOfWeek.Monday Then
txtRandomCharacter.Text = specialcharacters
End If
i would be extremely grateful if anyone could help, thank you!
How's this?
Const specialcharacters() As Char = "★☆☽☾☁"
Dim today As Date = Date.Today
Dim dayIndex As Integer = today.DayOfWeek
If dayIndex >= DayOfWeek.Monday andalso dayIndex <= DayOfWeek.Friday Then
txtRandomCharacter.Text = specialcharacters(dayIndex - dayOfWeek.Monday)
End If
It works because the value of DayOfWeek.Monday through DayOfWeek.Friday are sequential.
(Re-edit to correct my previous error of using VBA instead of VB.net)
Yes. Noting that you only have 5 Char in your array (specialcharacters()) I assume you only want to mark Monday to Friday. However, the answer to this question can be extended to cover all week. Using your original code as the base:
Dim txtRandomCharacter As Char = ""
Dim specialcharacters() As Char = "★☆☽☾☁"
Dim today As Date = Date.Today
Dim dayIndex As Integer = today.DayOfWeek
If (dayIndex - 1) <= UBound(specialcharacters) Then
txtRandomCharacter = specialcharacters(dayIndex - 1)
End If
However, note the mental gymnastics required in dealing with 0-based arrays.
Dim dayIndex As Integer = Weekday(today,vbMonday) is also valid code.
Explanation for Weekday can be found at http://www.excelfunctions.net/vba-weekday-function.html.
specialcharacters is an array, not a string, so that you can access the array element directly. I have used the UBound function so that you don't accidently get an array out of bounds error by calling a subscript (dayIndex) that is higher than your array is long.
Another option is to use the Mid or Substr function with strings. In this example I have also concatenated some code for brevity.
Dim txtRandomCharacter As String = ""
Const specialcharacters As String = "★☆☽☾☁"
Dim dayIndex As Integer = Date.Today.DayOfWeek ' - DayOfWeek.vbMonday + 1
txtRandomCharacter = If(dayIndex >= 0 And dayIndex <= Len(specialcharacters), specialcharacters.Substring(dayIndex - 1, 1), "X")
The 'X' option in the IIF statement was my addition for testing. You can also use "". Unfortunately, the Substr function in VB.Net is a little less tolerant than the Mid function, hence the additional checks on valid values for dayIndex. And Substr is 0-based.
Using the Mid function, which is tolerant of indexes > length of the string but must be > 0 (hence the If statement):
Dim txtRandomCharacter As String = ""
Const specialcharacters As String = "★☆☽☾☁"
Dim dayIndex As Integer = Date.Today.DayOfWeek ' - DayOfWeek.vbMonday + 1
txtRandomCharacter = Mid(specialcharacters, If(dayIndex > 0, dayIndex, Len(specialcharacters) + 1), 1)
Check your Option Base to see if your arrays start by default at 0 or 1. specialcharacters() could be ranging from 0-4 or 1-5 depending on this setting - which means is may or may not align with the Weekday function which is always in the range 1-7 (or the DayofWeek function which ranges from 0 to 6).
The key point is to understand the difference between a string and an array of characters.
With an array of characters - use array subscripts to select the right member. Check to ensure you are not passing an index that is out of bounds for the array.
With a string, use a Mid or Substr function to get the character from the string. Check to ensure you are not passing an index that is out of bounds.
The other point to recognise is to understand how the days of the week are enumerated. The MSDN reference site only notes the enumeration and does not provide an equivalent integer - the IDE provides some more information. This is important to understand if your counting starts from 0 or 1, and whether you must adjust your index to address this.
Related
I created a simple function in MATLAB, and am trying to convert the function into Excel VBA function. My goal is to create an Excel formula =RT('range of dB levels', 'delta-time') and output the estimated reverberation time. The math is simple, see MATLAB code below:
function rr=RT(lvl_broad, dt)
n=12; %number of samples within slope calc
slope=zeros(length(lvl_broad), 1);
for i=1:length(lvl_broad)
if i<((n/2)+1) | i>length(lvl_broad)-(n/2)-1
slope(i)=0;
else
slope(i)=(lvl_broad(i+(n/2))-lvl_broad(i-(n/2)))/n;
end
end
min_slope=min(slope);
rr=abs(dt./min_slope)*60;
end
In excel, I modified/simplified this until I no longer got errors, however, the cell that I enter my 'RT' function in returns #VALUE and I do not know why. Does anything stand out in the code below? (note I changed the input range from lvl_broad to InterruptedNZ)
Function RT(InterruptedNZ, dt)
Dim Slope As Double
Slope = Slope(InterruptedNZ.Height, 1)
For i = 1 To InterruptedNZ.Height
If i < ((6) + 1) Or i > (InterruptedNZ.Height - (6) - 1) Then
Slope(i) = 0
Else
Slope(i) = (InterruptedNZ(i + (6)) - InterruptedNZ(i - (6))) / 12
End If
Next
End
min_slope = Application.WorksheetFunction.Min(Slope)
RT = Abs((dt / min_slope) * 60)
End Function
Here are some tips to translate MATLAB code into VBA code:
length()
If you are trying to get the dimensions of a range, you'll need to use the .Rows.Count or .Columns.Count properties on the range you are working with.
PERFORMANCE NOTE:
When you have a large enough range, it's a good idea to store the values of the range inside an array since you will reduce the number of times you access data from the sheets which can comme with lot of overhead. If so, you'll have to use ubound() and lbound().
zeros()
In VBA, there is no exact equivalent to the zeros() function in MATLAB. The way we would initialize an array of zeros would simply be by initializing an array of doubles (or another numerical type). And since the default value of a double is zero, we don't need to do anything else :
Dim Slope() As Double
ReDim Slope(1 To InterruptedNZ.Rows.Count)
Note that you cannot pass the dimensions in the Dim statement since it only accepts constants as arguments, so we need to create Slope as a dynamic array of doubles and then redimension it to the desired size.
Putting these two principles together, it seems like your code would look something like this:
Function RT(ByRef InterruptedNZ As Range, ByVal dt As Double)
Dim Slope() As Double
ReDim Slope(1 To InterruptedNZ.Rows.Count)
Dim i As Long
For i = 1 To InterruptedNZ.Rows.Count
If i < ((6) + 1) Or i > (InterruptedNZ.Rows.Count - (6) - 1) Then
Slope(i) = 0
Else
Slope(i) = (InterruptedNZ(i + (6)) - InterruptedNZ(i - (6))) / 12
End If
Next
Dim min_slope As Double
min_slope = Application.WorksheetFunction.Min(Slope)
RT = Abs((dt / min_slope) * 60)
End Function
Addtionnal notes:
Refering to cells from a range like this InterruptedNZ(i) works but it is good practice to be more specific like this (assuming column range) :
InterruptedNZ.Cells(i,1)
During my tests, I had a division by zero error since min_slope was zero. You might want to account for that in your code.
I have the following input:
Dim str_format as string = "XXXXX00000"
Dim str as string = "INV"
Dim int as integer = "56"
How can I replace XXXXX with INV and replace 00000 with 56?
For the example above the result should be INVXX00056.
X can only replace with alphabet and 0 can only replace with integer, if str has more than five alphabet. The extra alphabets will be thrown away because str_format only has five X. The same algorithm is true for the integer.
Example 2
Dim str_format as string = "XXX00000"
Dim str as string = "ABCD"
Dim int as integer = 654321
Expected result: ABC54321
Process:
1. ABCD XXX00000 654321
2. ABC DXX000006 54321
3. AB CDX00065 4321
4. A BCD00654 321
5. ABC06543 21
6. ABC65432 1
7. ABC54321
As Spidey mentioned... show some code. That said the process you describe is a bit long-winded.
The Letter part of the solution can be done by grabbing the first 3 characters of str using Left(str,3) this will bring in the leftmost 3 character (if there are less it will get what is there). Then check that you have 3 characters using str.Length(). If the length is less than 3 then append the appropriate number of 'X'.
The Numeric part can be done in a similar way. Your int is actually a string in your code above. If it was a real integer you can cast it to string. Use Right(int,5). Again check to see you have 5 digits and if not prepend with appropriate number of 0.
Have a go... if you run into problems post your code and someone is bound to help.
UPDATE
As there have been actual answers posted here is my solution
Function FormatMyString(str As String, num as String) As String
Dim result As String
result = Left(str,3).PadRight(3, "X"c).ToUpper() & Right(num,5).PadLeft(5, "0"c)
Return result
End Function
UPDATE 2
based on Wiktors answer... made an amendment to my solution to cope with different formats
Function FormatMyString(str As String, num as String, alpha as Integer, digits as Integer) As String
Dim result As String
result = Left(str, alpha).PadRight(alpha, "X"c).ToUpper() & Right(num, digits).PadLeft(digits, "0"c)
Return result
End Function
To use...
FormatMyString("ABCDE", "56",3 5) will return ABC00056
FormatMyString("ABCDE", "123456",4 3) will return ABCD456
FormatMyString("AB", "123456",4 3) will return ABXX456
Here is a possible solution that just uses basic string methods and PadLeft/PadRight and a specific method to count occurrences of specific chars in the string. It assumes the format string can only contain X and 0 in the known order.
Public Function CountCharacter(ByVal value As String, ByVal ch As Char) As Integer
Return value.Count(Function(c As Char) c = ch)
End Function
Public Sub run1()
Dim str_format As String = "XXXXX00000" '"XXX00000"
Dim str As String = "INV"
Dim int As Integer = 56 ' ABC54321
Dim xCnt As Integer = CountCharacter(str_format, "X")
Dim zCnt As Integer = CountCharacter(str_format, "0")
Dim result As String
If xCnt > str.Length Then
result = str.PadRight(xCnt, "X")
Else
result = str.Substring(0, xCnt)
End If
If zCnt > int.ToString().Length Then
result = result & int.ToString().PadLeft(zCnt, "0")
Else
result = result & int.ToString().Substring(int.ToString().Length-zCnt
End If
Console.WriteLine(result)
End Sub
Output for your both scenarios is as expected.
Take a look at this sample
Dim str_format As String = str_format.Replace("XXX", "ABC")
Msgbox(str_format )
As we assume that the X is 3 only. I dont want to give you more it is a start and everything will be easy.
If that kind of format is fix I mean the number of X will go or down then you can make a conditional statement based on the length of string
Below is the code i have put together from various examples to try achieve my goal. Concept is to be dynamic and retrieve from survey sheet within my workbook, to be able to obtain the corresponding TVD for the MD
--Use while loop only to run code if there is a depth in Column B Present. Nested loop uses the difference between depths to calculate a gradient.
---The issue i'm having is getting past my first debug error "Invalid Qualifier".
----Lastly, any suggestions for how i would then return the TVD to Column A, relevant to the looked up MD, within the nested loop to maintain the row in which the MD was grabbed. Sorry for making this so wordy, been working on this for over 10hrs while at work.
http://www.wellog.com/tvd.htm
Sub MdtoTVD()
Dim MD1 As String, MD2 As Integer
Dim TVD1 As String, TVD2 As Integer
Dim Srng As Range 'Survey MD column
Dim MDrng As Range 'MdtoTVD MD column as range
Dim MDdiff As Integer ' Var to calculate difference of MD end from MD start
Dim TVDdiff As Integer ' Var to calculate difference of TVD end from TVD start
Dim TVDincr As Double ' var to use for stepping TVD
Dim MDrow As Integer
Dim i As Long
MDrng = Range("Surveys!B27:B215") 'range from the survey sheet within my report book
Srng = Range("Surveys!G27:G215") 'range from the survey sheet within my report book
Dim X As Integer
X = 2
While Not (IsEmpty(Sheets("MDtoTVD").Cells(X, 2).Value)) 'runs loop as long as there a MD depth to be looked up
Cells(X, 2) = MDrow 'assigns current row value to for MD input
MD1.Value = Application.WorksheetFunction.Index(Srng, Application.WorksheetFunction.Match(MDrow, MDrng, 1)) ' retrieves Start point for MD
MD2.Value = Application.WorksheetFunction.Index(Srng, Application.WorksheetFunction.Match(MDrow, MDrng, 1) + 1) 'retrieves end point for MD
TVD1.Value = Application.WorksheetFunction.Index(MDrng, Application.WorksheetFunction.Match(MDrow, Srng, 1)) 'retrieves start point for TVD
TVD2.Value = Application.WorksheetFunction.Index(MDrng, Application.WorksheetFunction.Match(MDrow, Srng, 1) + 1) 'retrieves end point for TVD
MDdiff.Value = (MD2 - MD1) 'assigns and calculates difference of MD end from MD start
TVDdiff.Value = (TVD2 - TD1) 'assigns and calculates difference of TVD end from TVD start
TVDincr.Value = MDdiff / TVDdiff 'Divides MD by TVD to get increment per foot
For i = 1 To MDdiff Step TVDincr 'set max loop run to amount of feet between survey points
Cells(X, 1).Value = TVD1 + i 'uses the loop to increment the TVD from start point
Next i
Wend
End Sub
I can see a number of problems with your code:
MD1, MD2, TVD1, TVD2 are all of type String. Also, MDdiff, TVDdiff and TVDIncr are all of type Integer. The property Value is not defined for a string or integer variable. Just remove the .Value from all of them and you won't get the "Invalid Qualifier" error.
After you do the above, the following lines will give another error about type mismatch:
MDdiff = (MD2 - MD1)
TVDdiff = (TVD2 - TD1)
because you're trying to subtract a string from another string and assign the result to an integer. Not sure what to advise there, you have to consider what you're trying to achieve and act accordingly. Maybe they shouldn't be strings in the first place? I don't know, up to you to determine that.
At the very least, you can cast strings to integers if you're really sure they're string representations of integers by doing CInt(string_var) or use CLng to convert to long. If the strings are not string representations of integers and you try to cast them to integers, you'll get a type mismatch error.
When you assign a value to a Range object, you need to use Set. So do:
Set MDrng = Range("Surveys!B27:B215")
Set Srng = Range("Surveys!G27:G215")
to correctly set the ranges.
Another problem is that you haven't assign a value to X but you use it as a cell index. By default, uninitialised numeric variables in VBA get assigned the value of 0, so doing .Cells(X, 2) will fail because row 0 is not a valid row index.
In this line:
TVDincr = MDdiff / TVDdiff
you're dividing two integers and you assign the result to another integer. Note that if the result of the division happens to be a decimal (like 3 / 2 = 1.5), your TVDincr integer will actually contain just 1, i.e. you lose some precision. I don't understand your code to know if it's ok or not, you have to judge for yourself, I'm pointing it out just in case you're not aware of that.
Also, if TVDdiff happens to be 0, then you'll get a "division by zero" error.
This line in your For loop:
Cells(X, 1).Value = TVD1 + i
will also generate an error, because you're trying to numerically add TVD1 (a string) and i (a long). Perhaps you're trying to concatenate the two, in which case you should replace + with &.
There's also a problem when calling the WorksheetFunctions, but I haven't been able to determine the cause. Probably if you fix the other errors then it'll be easier to understand what's going on, not sure though. You just have to investigate things a little bit too.
I have a table field 'Phone number', the data in table is imported through a excel file link in database. The data type of the field is text since we are not sure how user enters his phone number(sometime with country code and sometime without country code).
I want to format the 'phone number' field once the table is updated everytime or data is imported into table. Format [countrycode]-[localcode]-[phone num].
I am not sure how to go about it, whether to create an update query or VBA code to update this field. Will appriciate any help in this regards.
It is generally recommended that in database fields, the phone number is maintained in numerical format only (meaning no parenthesis, dashes, or whatnot) because it provides more stability for the data and allows for better/easier future formatting when outputting. The most recommended method is to take the number given to you and strip it of all non-numeric characters and then store that value.
If you are working with an excel sheet containing this information before it is put into the database, then you can simply format the column that contains the phone numbers to convert everything into a single numerical value so 800-555-1212 or (888) 222-1515 would just become 8005551212 and 8882221515. This can be done using the existing cell formatting option built into Excel or if you want it done on the fly a simple VBA code that triggers when the field has a value would do the trick too.
EDIT #1 (super simple function)
Public Function numOnly(sToClean As String) As String
Const NUM_CHARS = "0123456789"
Dim lChar As Long
Dim sResult As String
For lChar = 1 To Len(sToClean)
If InStr(1, NUM_CHARS, Mid$(sToClean, lChar, 1)) > 0 Then
'Found a numeric character
sResult = sResult + Mid$(sToClean, lChar, 1)
End If
Next
'Return the result
numOnly = sResult
End Function
EDIT #2 (more feature advanced version)
Option Explicit
Public Function stripChars(CheckStr As String, Optional KillNums As Boolean = False, Optional AllowedChars As String, Optional NotAllowed As String)
' CheckStr = the string being evaluated
' KillNums [True/False] = remove numbers/remove non-numeric
' AllowedChars = what to allow even if you are removing non-numeric (aka KillNums=False) [ex. "$,."] or removing numbers (aka KillNums=True) [ex. "6,9"]
' NotAllowed = override characters never allowed and processed before any other option (meaning if you have it in both allow/not allow - not allow takes precedence
' NOTE: AllowedChars and NotAllowed arguments are *not* case-sensitive
Dim Counter As Long
Dim TestChar As String
Dim TestAsc As Long
' Loop through characters
For Counter = 1 To Len(CheckStr)
' Get current character and its ANSI number
TestChar = Mid(CheckStr, Counter, 1)
TestAsc = Asc(TestChar)
' Test first to see if current character is never allowed
If InStr(1, NotAllowed, TestChar, vbTextCompare) > 0 Then
' do nothing
' If current character is in AllowedChars, keep it
ElseIf InStr(1, AllowedChars, TestChar, vbTextCompare) > 0 Then
stripChars = stripChars & TestChar
' If KillNums=True, test for not being in numeric range for ANSI
ElseIf KillNums Then 'only allow non-numbers
If TestAsc < 48 Or TestAsc > 57 Then
stripChars = stripChars & TestChar
End If
' If KillNums=False, test for being in numeric ANSI range
Else 'only allow numbers
If TestAsc >= 48 And TestAsc <= 57 Then
stripChars = stripChars & TestChar
End If
End If
Next
End Function
You can drop either of these in your Excel's module (Alt+F11) or in your Access forms or what not, good luck.
I need to truncate the amount of decimal places of my double value for display in a textbox. How would one achieve this with vba?
If you want to round the value, then you can use the Round function (but be aware that VBA's Round function uses Banker's rounding, also known as round-to-even, where it will round a 5 up or down; to round using traditional rounding, use Format).
If you want to truncate the value without rounding, then there's no need to use strings as in the accepted answer - just use math:
Dim lDecimalPlaces As Long: lDecimalPlaces = 2
Dim dblValue As Double: dblValue = 2.345
Dim lScale = 10 ^ lDecimalPlaces
Dim dblTruncated As Double: dblTruncated = Fix(dblValue * lScale) / lScale
This yields "2.34".
You can either use ROUND for FORMAT in VBA
For example to show 2 decimal places
Dval = 1.56789
Debug.Print Round(dVal,2)
Debug.Print Format(dVal,"0.00")
Note: The above will give you 1.57. So if you are looking for 1.56 then you can store the Dval in a string and then do this
Dim strVal As String
dVal = 1.56789
strVal = dVal
If InStr(1, strVal, ".") Then
Debug.Print Split(strVal, ".")(0) & "." & Left(Split(strVal, ".")(1), 2)
Else
Debug.Print dVal
End If
You can use Int() function. Debug.print Int(1.99543)
Or Better:
Public Function Trunc(ByVal value As Double, ByVal num As Integer) As Double
Trunc = Int(value * (10 ^ num)) / (10 ^ num)
End Function
So you can use Trunc(1.99543, 4) ==> result: 1.9954
This was my attempt:
Function TruncateNumber(decimalNum As Double, decPlaces As Integer) As Double
'decimalNum: the input number to be truncated
'decPlaces: how many decimal places to round to. Use 0 for no decimal places.
decimalLocation = InStr(decimalNum, ".")
TruncateNumber = Left(decimalNum, decimalLocation + decPlaces)
End Function
It uses strings to avoid any math errors caused by different rounding methods. It will output as a type double, so you can still perform your own math on it.
This will cause an error if a number without a decimal place is passed into the above function. If this is a concern, you can use the following code instead:
Function TruncateNumber(decimalNum As Double, decPlaces As Integer) As Double
'decimalNum: the input number to be truncated
'decPlaces: how many decimal places to round to. Use 0 for no decimal places.
If InStr(decimalNum, ".") = 0 Then 'if there was no decimal:
'then return the number that was given
TruncateNumber = decimalNum
Else 'if there is a decimal:
'then return the truncated value as a type double
decimalLocation = InStr(decimalNum, ".")
TruncateNumber = Left(decimalNum, decimalLocation + decPlaces)
End If
End Function
Hopefully these functions are of some use to someone. I haven't done extensive testing, but they worked for me.
EDITED
Newer version of Excel (VBA) have a TRUNC function which already does things properly.
For older versions of EXCEL
I wanted to truncate a double into an integer.
value = Int(83.768)
value == 83
Awesome, it worked.
Depending on your version of Excel (VB) this might not work with negative numbers.
value = Int(-83.768)
value == -84
VB uses Banker rounding.
Public Function Trunc1(ByVal value As Double) As Integer
' Truncate by calling Int on the Absolute value then multiply by the sign of the value.
' Int cannot truncate doubles that are negative
Trunc1 = Sgn(value) * Int(Abs(value))
End Function
If you want specific decimal places do what Makah did only with Abs around the value so Int can truncate properly.
Public Function Trunc2(ByVal value As Double, Optional ByVal num As Integer = 1) As Double
' Truncate by calling Int on the Absolute value then multiply by the sign of the value.
' Int cannot truncate doubles that are negative
Trunc2 = Sgn(value) * (Int(Abs(value) * (10 ^ num)) / (10 ^ num))
End Function
Here is a little experiment I did... (1st time posting and answer, please tell me if I am not following conventions.
Sub Truncate()
Dim dblNum As Double
Dim intDecimal As Integer
dblNum = 1578.56789
intDecimal = 2 '0 returns 1578
'2 returns 1578.56
'-2 returns 1500
Debug.Print (Int(dblNum * 10 ^ intDecimal) / 10 ^ intDecimal)
End Sub