I am attempting to write a UDF using Countifs. I want the user to be able to select criteria 1 (held as X1) and the month (held as month_X). The month in the lookup table is in numbers so I want the function to convert the month name to the month number.
This works - but is there a better way to convert the data? I.e. less lines of code?
Function CountIF_Custom(X1 As String, Month_X As String)
Dim MonthArray(1 To 12, 1 To 2) As Variant
MonthArray(1, 1) = "January"
MonthArray(2, 1) = "February"
MonthArray(3, 1) = "March"
MonthArray(4, 1) = "Apr"
MonthArray(5, 1) = "May"
MonthArray(6, 1) = "June"
MonthArray(7, 1) = "July"
MonthArray(8, 1) = "August"
MonthArray(9, 1) = "September"
MonthArray(10, 1) = "October"
MonthArray(11, 1) = "November"
MonthArray(12, 1) = "December"
MonthArray(1, 2) = "1"
MonthArray(2, 2) = "2"
MonthArray(3, 2) = "3"
MonthArray(4, 2) = "4"
MonthArray(5, 2) = "5"
MonthArray(6, 2) = "6"
MonthArray(7, 2) = "7"
MonthArray(8, 2) = "8"
MonthArray(9, 2) = "9"
MonthArray(10, 2) = "10"
MonthArray(11, 2) = "11"
MonthArray(12, 2) = "12"
For x = 1 To 12
If Month_X = MonthArray(x, 1) Then
Month_X = MonthArray(x, 2)
End If
Next x
CountIF_Custom = Application.CountIfs(Sheets("SomeSheet").Range("SomeRange"), X1, Sheets("SomeSheet").Range("SomeRange"), Month_X)
End Function
No need for the array, you can use a for loop with the MonthName function:
Function CountIF_Custom(X1 As String, Month_X As String)
Dim x As Integer
For x = 1 To 12
If Month_X = MonthName(x) Then
Month_X = CStr(x)
Exit For
End If
Next x
CountIF_Custom = Application.CountIfs(Sheets("SomeSheet").Range("SomeRange"), X1, Sheets("SomeSheet").Range("SomeRange"), Month_X)
End Function
Related
Function Zad3(x As String, y As Date)
Dim z As String, c As Integer
z = Right(x, 1)
c = Left(Right(x, 2), 1)
Select Case z
Case Is = "M"
Zad3 = DateAdd("m", c, y)
Case Is = "R"
Zad3 = DateAdd("yyyy", c, y)
Case Is = "L"
Zad3 = DateAdd("yyyy", c, y)
Case Else
Zad3 = "nieznana"
End Select
End Function
So "z" is "L", "M" or "R", where "L","R" = year and "M" = month. I need to add to the date 3L, so 3 years, it works. I have a problem where there's sth else e.g. "?".It should show "nieznane" because of the Else Case, but it doesn't. Idk how to solve it, any ideas?
the problem lies in:
c = Left(Right(x, 2), 1)
which would error out forx ="?", since:
Left(Right(x, 2), 1) would yeald "?"
c is declared as Integer
and VBA interpreter couldn't convert "?" to any integer value for c
so, you should move that statement inside their proper, and safe, cases
Function Zad3 (x As String, y As Date)
Dim z As String, c As Integer
z = Right(x, 1)
Select Case z
Case Is = "M"
c = Left(Right(x, 2), 1)
Zad3 = DateAdd("m", c, y)
Case Is = "R"
c = Left(Right(x, 2), 1)
Zad3 = DateAdd("yyyy", c, y)
Case Is = "L"
c = Left(Right(x, 2), 1)
Zad3 = DateAdd("yyyy", c, y)
Case Else
Zad3 = "nieznana"
End Select
End Function
a short version of which, could be
Public Function Zad3(x As String, y As Date)
Dim z As String
z = Right(x, 1)
Select Case z
Case "M", "R", "L"
Zad3 = DateAdd(Switch(z = "M", "m", z = "R", "yyyy", z = "L", "yyyy"), Left(x, Len(x) - 1), y)
Case Else
Zad3 = "nieznana"
End Select
End Function
where I used VBA Switch() function to collapse what would be another Select Case block
Conditional Date Modification
Option Explicit
Function Zad3(SourceString As String, SourceDate As Date) As Variant
' Function restriction: only 1 to 9 months or years can be added.
Dim strT As String ' Type String
Dim strN As String ' Number String
Dim lngN As Long ' Number Number
' Check if there is at least two characters in SourceString.
If Len(SourceString) < 2 Then GoTo Nieznana
' Calculate Type String (right-most character).
strT = Right(SourceString, 1)
' Calculate Number String (first (left) of the two right-most characters).
strN = Left(Right(SourceString, 2), 1)
' Check if Number String can be converted to a number.
If Not IsNumeric(strN) Then GoTo Nieznana
' Convert Number String to Number Number.
lngN = CLng(strN)
' It there was no IsNumeric:
' On Error Resume Next
' lngC = CLng(strN)
' If Err.Number > 0 Then GoTo Nieznana
' On Error GoTo 0
' Calculate resulting date (Zad3).
Select Case strT
Case Is = "M": Zad3 = DateAdd("m", lngN, SourceDate)
Case Is = "R", "L": Zad3 = DateAdd("yyyy", lngN, SourceDate)
Case Else: GoTo Nieznana
End Select
Exit Function
Nieznana:
' 1. Source String has less than two characters.
' 2. Number String can not be converted to a number.
' 3. Type String is not "M", "R" or "L".
Zad3 = "nieznana"
End Function
I am trying to write a simple macro to change a date format mm/dd/yy to just the month full name. This is what I have using a days worth experience in VBA. I'm missing the error here
Sub ChangeDate()
Dim Last As Integer
Last = Cells(Rows.Count, 1).End(xlUp).Row
Dim Counter As Integer
For Counter = 2 To Last
Dim Month As String
Month = Left(Worksheets("Sheet1").Cells(Counter, 2), 1)
If Month = "7" Then
Worksheets("Sheet1").Cells(Counter, 2).Value = "July"
ElseIf Month = "8" Then
Worksheets("Sheet1").Cells(Counter, 2).Value = "August"
ElseIf Month = "9" Then
Worksheets("Sheet1").Cells(Counter, 2).Value = "September"
End If
Next Counter
End Sub
Try using this code:
Sub ChangeDate()
Dim Counter As Long
Dim Last As Integer
Worksheets("Sheet1").Select
Last = Cells(Rows.Count, 1).End(xlUp).Row
For Counter = 2 To Last
Dim Month As String
Month = Left(Worksheets("Sheet1").Cells(Counter, 1), 1)
If Month = "7" Then
Worksheets("Sheet1").Cells(Counter, 2).Value = "July"
ElseIf Month = "8" Then
Worksheets("Sheet1").Cells(Counter, 2).Value = "August"
ElseIf Month = "9" Then
Worksheets("Sheet1").Cells(Counter, 2).Value = "September"
End If
Next Counter
End Sub
This code reads the date in column 1 and puts the month in column 2.
Is a good advice to use Case statement instead of ElseIf.
This program was made with Excel Visual Basic and should count the frequenzy of the letters that appear in a word you write into the A-1 cell.
For example apple - 1x a, 1x e, 1x l, 2x p, and the rest 0x
Public Sub Test()
Dim word As String
Dim wordarr(999) As String
Dim alph(1 To 29) As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
i = 1
j = 1
k = 1
m = 1
With ThisWorkbook.Worksheets("Tabelle1")
word = .Cells(1, 1)
'clearing the columns to rewrite it
.Columns(3).EntireColumn.Clear
.Columns(4).EntireColumn.Clear
'initializing my alphabet array
alph(1) = "a": alph(2) = "b": alph(3) = "c": alph(4) = "d": alph(5) = "e": alph(6) = "f":
alph(7) = "g": alph(8) = "h": alph(9) = "i": alph(10) = "j": alph(11) = "k": alph(12) = "l":
alph(13) = "m": alph(14) = "n": alph(15) = "o": alph(16) = "p": alph(17) = "q": alph(18) = "r":
alph(19) = "s": alph(20) = "t": alph(21) = "u": alph(22) = "v": alph(23) = "w": alph(24) = "x":
alph(25) = "y": alph(26) = "z": alph(27) = "_": alph(28) = "-": alph(29) = " "
'filling up the C column with my alphabet array
For i = 1 To 29
.Cells(i, 3) = alph(i)
Next i
'converting the string word into an array
For j = 1 To Len(word)
wordarr(j) = Mid(word, j, 1)
If j = Len(word) Then
Exit For
End If
Next j
'counting the frequency of each letter in the word and writing it into
'the column next to it
For m = 1 To 29
For k = 1 To Len(word)
If alph(m) = wordarr(k) Then
.Cells(m, 4) = .Cells(m, 4).Value + 1
End If
Next k
Next m
End With
End Sub
The program is working, but it isn't working fine i guess. Do you have any suggestions on how to optimize it without over-complicating it too much, I'm pretty new to this language. Is there also another way of initializing the array. I have tried several ways but it more often than not didn't work.
I am looking forward to seeing your suggestions.
here is another
i added a conversion to lower case so that uppercase characters are also counted
also added counting of "*", just as an example
Public Sub Test()
Dim word As String
Dim letter As String
Dim pointer As Integer
Dim i As Integer
With ThisWorkbook.Worksheets("Tabelle1")
word = LCase(.Cells(1, 1)) ' change text to all lower case
.Columns(3).EntireColumn.Clear ' clearing the columns to rewrite it
.Columns(4).EntireColumn.Clear
For i = 1 To 26 ' filling up the C column with my alphabet array
.Cells(i, 3) = Chr(i + 96) ' chr(97)=="a", chr(122)=="z"
Next i
.Cells(27, 3) = "_" ' oddballs
.Cells(28, 3) = "-"
.Cells(29, 3) = "<space>"
.Cells(30, 3) = "*"
For i = 1 To Len(word) ' scan text and update cells as you go
letter = Mid(word, i, 1)
' If i = Len(word) Then ' "for .. next" command already does this
' Exit For
' End If
Select Case letter
Case "a" To "z"
pointer = Asc(letter) - 96 ' asc("a")==97, asc("z")==122
Case "_"
pointer = 27
Case "-"
pointer = 28
Case " "
pointer = 29
Case "*"
pointer = 30
Case Else
GoTo skip_cell_update ' this character is not counted
End Select
.Cells(pointer, 4) = .Cells(pointer, 4).Value + 1 ' increment cell
skip_cell_update:
Next i
End With
End Sub
Here is soemthing short and sweet that im sure youll be able to expand upon quite easily
Private Sub THIS()
Dim Char As String, compareString As String, testString As String
Dim strCount As Long, i As Long, j As Long, y As Long, rCount As Long
Dim arr(28, 1) As String
testString = ThisWorkbook.Sheets("Sheet1").Range("a1").Value
For i = 1 To Len(testString)
Char = Mid(testString, i, 1)
For j = 1 To Len(testString)
For y = LBound(arr, 1) To UBound(arr, 1)
If Char = arr(y, 0) Then
GoTo Nexti
End If
Next y
compareString = Mid(testString, j, 1)
If Char = compareString Then
strCount = strCount + 1
End If
Next j
Debug.Print ; Char
Debug.Print ; strCount
arr(i, 0) = Char
arr(i, 1) = strCount
Nexti:
strCount = 0
Next i
End Sub
I have cells in vba that contain strings like this:
QUANTITY SUPPLY <= DAYS SUPPLY|30 IN 23 DAYS
I send these strings through two functions that just picks out the two numbers and parses them into the appropriate cells and just scraps the rest. The function that picks out the days number (23) is working fine but the function that picks out the 30 is not. I have been testing it and it seems to be parsing out the 30 as well as the whole string before it when all I want is the 30. In the case of the above string, it is returning "QUANTITY SUPPLY <= DAYS SUPPLY|30" when all I want it to return is the 30. I have looked at the function and cannot find the issue. Any help with this issue would be greatly appreciated!
Public Function extractQLlMax(cellRow, cellColumn) As String
qlm = Cells(cellRow, cellColumn).Value
extractQLlMax = qlm
If extractQLinfoBool = "Yes" And Not InStr(1, qlm, "IN") = 0 Then
If InStr(1, qlm, "QUANTITY SUPPLY") > 0 Then
pipeIndex = InStr(1, qlm, "|")
inIndex = InStr(1, qlm, "IN")
extractQLlMax = Mid(qlm, pipeIndex, inIndex - pipeIndex)
End If
inIndex = InStr(1, qlm, "IN")
extractQLlMax = Mid(qlm, 1, inIndex - 2)
ElseIf extractQLinfoBool = "Yes" And Not InStr(1, qlm, "FILL") = 0 Then
perIndex = InStr(1, qlm, "PER")
extractQLlMax = Mid(qlm, 1, perIndex - 2)
End If
End Function
This is by far the shortest (5 lines) function to extract the numbers!
Function GetNumbers(str As String, Occur As Long) As Long
Dim regex As Object: Set regex = CreateObject("vbscript.RegExp")
regex.Pattern = "(\d+)"
Regex.Global = True
Set matches = regex.Execute(str)
GetNumbers = matches(Occur)
End Function
Parameters:
Str is the string to extract numbers from
Occur is the occurrence of that number (it's 0-based so the first number will have the occurence of 0 not 1 and so on)
Have you considered using the "Split" function in VBA? If it is always pipe delimited, you could try:
Public Function extractQLlMax(cellRow, cellColumn) As String
Dim X as Variant
qlm = Cells(cellRow, cellColumn).Value
extractQLlMax = qlm
If extractQLinfoBool = "Yes" And Not InStr(1, qlm, "IN") = 0 Then
If InStr(1, qlm, "QUANTITY SUPPLY") > 0 Then
x = Split(qlm,"|")
extractQLlMax = X(ubound(x))
ElseIf extractQLinfoBool = "Yes" And Not InStr(1, qlm, "FILL") = 0 Then
perIndex = InStr(1, qlm, "PER")
extractQLlMax = Mid(qlm, 1, perIndex - 2)
End If
End Function
This will extract the first number in a string:
Public Function GetNumber(s As String) As Long
Dim b As Boolean, i As Long, t As String
b = False
t = ""
For i = 1 To Len(s)
If IsNumeric(Mid(s, i, 1)) Then
b = True
t = t & Mid(s, i, 1)
Else
If b Then
GetNumber = CLng(t)
Exit Function
End If
End If
Next i
End Function
You might pass an optional parameter in to distinguish which number you want to pull.
Public Function days_supply(blurb As String, Optional i As Long = 1)
Dim sTMP As String
sTMP = Trim(Split(blurb, "|")(1))
If i = 1 Then
days_supply = CLng(Trim(Left(Replace(sTMP, " ", Space(99)), 99)))
Else
sTMP = Trim(Mid(sTMP, InStr(1, LCase(sTMP), " in ", vbTextCompare) + 4, 9))
days_supply = CLng(Trim(Left(Replace(sTMP, " ", Space(99)), 99)))
End If
End Function
The formula in B1 is,
=days_supply(A1)
The formula in C1 is,
=days_supply(A1,2)
Need to print a table of any numbers using VBA in excel. i.e blank row after each row . Below iswhat i wrote to print a table in consecutive rows, But i dont know how can i print the result in alternate rows?
Sub table()
a = InputBox("Enter first no")
ActiveSheet.Cells.Clear
ActiveSheet.Cells(5, 4) = "TABLE OF " & a
For i = 1 To 10
c = a * i
ActiveSheet.Cells(i + 5, 4) = a
ActiveSheet.Cells(i + 5, 5) = "*"
ActiveSheet.Cells(i + 5, 6) = i
ActiveSheet.Cells(i + 5, 7) = "="
ActiveSheet.Cells(i + 5, 8).Value = c
next i
End Sub
Sub table()
a = InputBox("Enter first no")
n As Integer
n=6
ActiveSheet.Cells.Clear
ActiveSheet.Cells(5, 4) = "TABLE OF " & a
For i = 1 To 10
c = a * i
ActiveSheet.Cells(n, 4) = a
ActiveSheet.Cells(n, 5) = "*"
ActiveSheet.Cells(n, 6) = i
ActiveSheet.Cells(n, 7) = "="
ActiveSheet.Cells(n, 8).Value = c
n = n + 2
next i
End Sub
Change your row number calculation from
i + 5
to
(i * 2) + 4