VBA Excel: Modulus for quarters - vba

Please assist me in defining a modulus function for quarters: QuarterMod()
The function is to represent the quarter that you'll get when you take step a certain number of quarters in time.
Example:
Today, Juli 2013, we are at Q3.
What quarter will we be at a year from now? Well, todays quarter plus a year, i.e. 3 + 4
Ans = QuarterMod(3 + 4)
Ans = 3
More examples:
QuarterMod(-1) = 3
QuarterMod(0) = 4
QuarterMod(1) = 1
QuarterMod(2) = 2
QuarterMod(3) = 3
QuarterMod(4) = 4
QuarterMod(5) = 1
And so on.

You mean like this ? ...
Function QuarterMod(ByVal n As Integer) As Integer
If n = 0 Then
QuarterMod = 0
Exit Function
End If
QuarterMod = n Mod 4
If QuarterMod = 0 Then QuarterMod = 4
If QuarterMod < 0 Then QuarterMod = QuarterMod + 4
End Function

How about this:
Public Function QuarterMod(Qtr As Integer)
Dim i As Integer
i = Qtr Mod 4
If i <= 0 Then
i = i + 4
End If
QuarterMod = i
End Function

Related

Loop through a string to find the odd numbers VB

I am looping through a card number finding all the odd numbers and multiplying them by the card digits. Its kind of hard to explain. I am having trouble multiplying the odd number and the card number. Here's an example my teacher gave me. You multiply card number 1 and and odd number 1 and so forth. I am not getting any errors, it just kind of freezes.
Sums
Card #: 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6
Multiples 1 2 3 4 5 6 7 8
Evens: 2 4 6 8 0 2 4 6 32 =Sum 1
Odds: 1 6 15 28 45 6 21 40 162 =Sum 2
Sum 3: 194
194 =Sum 3
Step 4: =1+9+4 = 14
= 1 + 4 = 5 = check digit
Public Class Payment
Private Sub OK_Click(sender As Object, e As EventArgs) Handles OK.Click
Dim Sum1 = 0
Dim Sum2 = 0
Dim Sum3 = 0
Dim ready As Boolean
Dim ccnumb = CardNumber.Text
Format(CardNumber.Text, "################")
Dim exp = Mid(ExpDate.Text, 1, 3)
Dim checkdigit = 0
If FullName.TextLength = 0 Or cardtype.Text.Length = 0 And ccnumb.Length <= 16 Or exp.Length = 2 Then
MessageBox.Show("Please enter all credit card information before proceeding.")
ready = False
Else ready = True
End If
If ready = True Then
For Each num As Char In ccnumb
If CInt(CStr(num)) Mod 2 <> 0 Then
Sum1 += CInt(CStr(num)) * CInt(CStr(num)) Mod 2 <> 0
Else
Sum2 += CInt(CStr(num))
End If
Next
Sum3 = Sum1 + Sum2
Do While Sum3 > 10
For j = 0 To Sum3.ToString.Length - 1
For k = 1 To Sum3.ToString.Length - 1
Sum3 = j + k
Next
Next
Loop
Do While exp.Length > 1
checkdigit = Mid(ExpDate.Text, 1, 1) + Mid(ExpDate.Text, 1, 2)
Loop
If Sum3 = checkdigit Then
MessageBox.Show("Congratulations! Your payment was successful.")
CustInv.Show()
Else MessageBox.Show("The checkdigit," & Space(1) & Sum3 & Space(1) & "does not match the month code," & Space(1) & checkdigit & "." & Space(1) & "Please reenter your card information.")
End If
End If
End Sub
"it kind of freezes" is lay speak for "my code enters an infinite loop".
This looks suspicious:
Do While Sum3 > 10
For j = 0 To Sum3.ToString.Length - 1
For k = 1 To Sum3.ToString.Length - 1
Sum3 = j + k
Next
Next
Loop
To enter the loop, Sum3 must be greater than 10. For the loop to exit, Sum3 must not be greater than 10, but your code only increments Sum3, so Sum3 can only stay greater than 10.
This means that once entered, this loop is infinite.
If changing outer loop to inside loop doesn't help you
Try this
Do While Sum3 > 10 and j < sum3 ' adding j < sum3 might stop the loop
For j = 0 To Sum3.ToString.Length - 1
For k = 1 To Sum3.ToString.Length - 1
Sum3 = j + k
Next
Next
Loop

A function returns a MsgBox 10 times?

Found a function on Excelguru which I changed a few things in and gonna edit some more. The idea is to use this to register worked hours and minutes.
There is one thing in this I don't understand: if I type the wrong time in the column reff I get a msg that its wrong, but it wont disappear unless I click it 10 times. I cant see what Im doing wrong. The entire code is posted and Im grateful for any help.
Use his function as part of the formula in the sheet like: TimeValue($E2;$F2;"16:00";"18:00";B2;9;C2)
Function TimeValue(FromTime As String, ToTime As String, StartTime As String, StopTime As String, Optional Weekday As String, Optional Daynr As Integer, Optional Holiday As String)
Dim x As Long
Dim F As Double
Dim T As Double
Dim Start As Double
Dim Stopp As Double
Dim Min As Long
Dim Day As Integer
Dim OverMid As Boolean
Select Case LCase(Weekday)
Case "mandag"
Day = 1
Case "tirsdag"
Day = 2
Case "onsdag"
Day = 3
Case "torsdag"
Day = 4
Case "fredag"
Day = 5
Case "lordag"
Day = 6
Case "sondag"
Day = 7
Case "x"
Day = 8
Case Else
Day = 0
End Select
OverMid = False
If LCase(Holiday) = "x" Then Day = 8
If Len(FromTime) = 0 Or Len(ToTime) = 0 Then
Exit Function
End If
If Len(FromTime) <> 5 Then
MsgBox ("Use format TT:MM - From time is wrong:" & FromTime)
Exit Function
End If
If Len(ToTime) <> 5 Then
MsgBox ("Use format TT:MM - To time is wrong:" & ToTime)
Exit Function
End If
F = Val(Left(FromTime, 2)) * 60 + Val(Right(FromTime, 2))
T = Val(Left(ToTime, 2)) * 60 + Val(Right(ToTime, 2))
Start = Val(Left(StartTime, 2)) * 60 + Val(Right(StartTime, 2))
Stopp = Val(Left(StopTime, 2)) * 60 + Val(Right(StopTime, 2))
If T = 0 Then T = 24 * 60
If T < F Then
T = T + 24 * 60
OverMid = True
End If
If Stopp = 0 Then Stopp = 24 * 60
For x = F + 1 To T
If x > Start And x <= Stopp Then
Min = Min + 1
End If
Next x
If OverMid = True Then
For x = 0 To Val(Left(ToTime, 2)) * 60 + Val(Right(ToTime, 2))
If x > Start And x <= Stopp Then
Min = Min + 1
End If
Next x
End If
'If weekday is set, equal to day
If Daynr <> 0 Then
If Daynr <> 9 Then
If Day <> Daynr Then Min = 0
End If
If Daynr = 9 And (Day > 5) Then
Min = 0
End If
End If
TimeValue = Min / 60
End Function
And the sub in the sheets
Private Sub Worksheet_Change(ByVal Target As Range)
Dim streng As String
Dim k As Long
Dim r As Long
k = Target.Column
r = Target.Row
If Cells(1, k) = "P" Then
If Cells(r, k) = "x" Then
Cells(r, 4) = "x"
Else
Cells(r, 4) = ""
End If
End If
End Sub
Message boxes really don't belong in UDFs (VBA functions meant to be used as spreadsheet functions).
Instead of the message box you could use code like:
If Len(FromTime) <> 5 Then
TimeValue = "Error! Use format TT:MM - From time is wrong:" & FromTime
Exit Function
Or perhaps:
If Len(FromTime) <> 5 Then
TimeValue = CVErr(xlErrValue)
Exit Function
This later will cause #VALUE! to display in the cell. Include enough documentation in your spreadsheet so that users can interpret such error values.

project euler problem17 vb code bug

If the numbers 1 to 5 are written out in words: one, two, three, four, five, then there are 3 + 3 + 5 + 4 + 4 = 19 letters used in total.
If all the numbers from 1 to 1000 (one thousand) inclusive were written out in words, how many letters would be used?
NOTE: Do not count spaces or hyphens. For example, 342 (three hundred and forty-two) contains 23 letters and 115 (one hundred and fifteen) contains 20 letters. The use of "and" when writing out numbers is in compliance with British usage.
my answer is coming 21148. i cant find the mistake here is my code in vb
the answer should be 21124
Dim length As UInt32 = 11
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
For i = 1 To 999
If i / 10 < 1 Then
single_digit(i)
ElseIf i / 10 = 1 Then
ten()
ElseIf i / 10 > 1 And i / 10 < 2 Then
ele_twe_thi(i)
ElseIf i / 10 >= 2 And i / 10 < 10 Then
multiple_10(Math.Floor(i / 10) * 10)
single_digit(i Mod 10)
ElseIf i = 100 Then
single_digit(i / 100)
length += 7
ElseIf i Mod 100 >= 11 And i Mod 100 <= 19 Then
length += 10
single_digit(Math.Floor(i / 100))
ele_twe_thi(i Mod 100)
ElseIf i Mod 100 = 10 Then
length += 3
single_digit(Math.Floor(i / 100))
length += 10
Else
length += 10
single_digit(Math.Floor(i / 100))
multiple_10(Math.Floor((i Mod 100) / 10) * 10)
single_digit(i Mod 10)
End If
Next
MsgBox(length)
End Sub
Private Sub single_digit(num)
If num = 1 Then
length = length + 3
ElseIf num = 2 Then
length = length + 3
ElseIf num = 3 Then
length = length + 5
ElseIf num = 4 Then
length = length + 4
ElseIf num = 5 Then
length = length + 4
ElseIf num = 6 Then
length = length + 3
ElseIf num = 7 Then
length = length + 5
ElseIf num = 8 Then
length = length + 5
ElseIf num = 9 Then
length = length + 4
End If
End Sub
Private Sub ele_twe_thi(num)
If num = 11 Or num = 12 Then
length = length + 6
ElseIf num = 13 Or num = 14 Or num = 18 Or num = 19 Then
length = length + 8
ElseIf num = 17 Then
length = length + 9
ElseIf num = 15 Or num = 16 Then
length = length + 7
End If
End Sub
Private Sub multiple_10(num)
If num = 20 Then
length = length + 6
ElseIf num = 30 Then
length = length + 6
ElseIf num = 40 Then
length = length + 5
ElseIf num = 50 Then
length = length + 5
ElseIf num = 60 Then
length = length + 5
ElseIf num = 70 Then
length = length + 7
ElseIf num = 80 Then
length = length + 6
ElseIf num = 90 Then
length = length + 6
End If
End Sub
Private Sub ten()
length = length + 3
End Sub
every time the program reaches 100, 200, 300 etc. is it adding an "and" unnecessarily?

Why doesn't my VBA function work properly?

I'm very new to VBA and programming, so this might be a dumb question. I have written the following code:
Function central(X)
Dim xc(300, 10), xa(200)
m = X.Rows.Count
n = X.Columns.Count
For j = 1 To n
xa(j) = 0
For i = 1 To m
xa(j) = xa(j) + X(i, j)
Next i
xa(j) = xa(j) / m
For i = 1 To m
xc(i, j) = X(i, j) - xa(j)
Next i
Next
central = xc()
End Function
This should output a matrix whose elements are subtracted from the average value of their columns.
My problem is that the output is shifted with one row and column. So for example for this table:
1 1 1
2 2 2
3 3 3
it gives me:
0 0 0
0 -1 -1
0 0 0
Thanks in advance!

How to get the multiples of 3 or 5 in vb.net?

How can I get the multiples of 3 or 5 in vb.net? I have this code but it gives me different output. Please help me.
Dim x As Integer
For x = 3 To 10
If x Mod 2 <> 0 Then
Dim sum As Integer
sum += x
MsgBox(x)
End If
Next
The output will be 3,5,7,9. The expected output should be 3,5,6,9. So any help?
x Mod 2 <> 0 gives you all numbers except numbers that are divisible by 2. But you want all numbers that are divisible by 3 or 5.
So this gives you the expected output:
For x = 3 To 9
If x Mod 3 = 0 OrElse x Mod 5 = 0 Then
' ... '
Note that my loops ends with 9 instead of 10 since 10 would be divisible by 5 but you dont expect it.
For Each i As Integer In Enumerable.Range(1,10) _
.Where(Function(i) i Mod 3 = 0 OrElse i Mod 5 = 0)
MsgBox(i)
Next i
Why do you check x Mod 2 <> 0, when you need multiplies of 3 and 5? Try following:
Dim x As Integer
For x = 3 To 10
If x Mod 3 = 0 OrElse x Mod 5 = 0 Then
Dim sum As Integer
sum += x
MsgBox(x)
End If
Next