Im 'trying' to make a message box that display how many present and absents there are in a column so the user can either click ok and the data being copied or pressing cancel and ending the code.
The problem is the i cant seem to get the CountIf part to work where it counts the number of absents and presents before displaying them in the Message Box.
Im Pretty new to coding so its probably a real mess but any help and id be grateful:)
Sub SubmitAttendance()
Dim Response As String
Dim Question As String
Dim PresentNumber As String
Dim AbsentNumber As String
Function As Integer
PresentNumber = Countif(Range("E:E"), Present)
AbsentNumber = Countif(Range("E:E"), Absent)
End Function
Question = "PresentNumber Present and AbsentNumber Absent"
Response = MsgBox(Question, vbOKCancel, "Register Totals")
If Response = vbOK Then
Range("E:E").Select
Selection.Copy
Range("F:ZZ").Find("").Select
Selection.PasteSpecial
Else
Exit Function
End If
End Sub
Excel functions are available in WorkSheetFunctions module, like:
WorksheetFunctions.CountIf(Arg1 As Range, Arg2)
Also, pass your second argument as string, not as a variable (VB's hectic nature will declare an uninitialized variable of that name for you, which is probably not what you want.
So your CountIf line should be like:
WorksheetFunction.CountIf( Range("E:E") , "Present")
Related
I am trying to develop a tool that will help standardize a description catalog of products. I want to have an input box prompt a user to enter a size. I want to encourage size entries like "5-1/2" and prevent users from entering "5.5". Ideally, if the size was entered with a decimal and not a dash with a fraction, I want a message box to pop up saying they can not do that. It would then need to re-show the input box.
Here is what I have -
Private Sub CS_Other_Click()
Unload Me
Sheets("Fill In").Activate
Worksheets("Fill In").Range("C2").NumberFormat = "#"
Dim other_casing_size As Variant
other_casing_size = InputBox("Fill in the casing size. Syntax MUST be in the form of X-X/X", "New Casing Size")
Range("C2") = other_casing_size
I just dont know the code to prevent an entry with decimals. Even better, if i knew how to code an exact syntax to include or exclude anything I wanted that would be perfect.
Thanks
A while loop, which checks the input string for a dot or comma would work quite ok, I guess:
Sub TestMe()
Dim inputString As String
Dim inputNumeric As Boolean
inputString = InputBox("Please, enter a number!")
inputNumeric = isNumeric(Evaluate(inputString))
Do While InStr(1, inputString, ".") Or _
InStr(1, inputString, ",") Or _
Not inputNumeric
If Not CBool(inputNumeric) Then
MsgBox "You tried to cancel or entered empty value!"
Exit Do
End If
MsgBox "Please, do not write dot or comma!"
inputString = InputBox("Please, enter a number!")
inputNumeric = isNumeric(Evaluate(inputString))
Loop
End Sub
The isNumeric() checks the input for being able to be converted to numeric. Thus 5-1/2 should be ok.
Concerning cancellation or entering empty value from the InputBox() - it really depends on the business logic of the "app", but in the case above - there is a msgbox and it exits the loop.
Write a separate function responsible for that prompt, and use it e.g. like this:
Dim casingSize As String
If GetCasingSize(casingSize) Then
ActiveSheet.Range("C2").Value = casingSize
End If
The function needs to return a Boolean for this to work - it returns True if the input is valid, False if there's no valid input to work with (e.g. prompt was cancelled). What makes this work, is passing the result as a ByRef argument, like this:
Public Function GetCasingSize(ByRef outResult As String) As Boolean
Do
Dim raw As Variant
raw = InputBox("Casing size?")
If VarType(raw) = vbBoolean Then
'handle cancelled prompt:
Exit Do
End If
If ValidateFractional(raw) Then
'handle valid input:
outResult = CStr(raw)
GetCasingSize = True
Exit Do
End If
'handle invalid input:
If MsgBox("The value '" & raw & "' is not valid. Try again?", vbYesNo) = vbNo Then
Exit Do
End If
Loop
End Function
Note the ValidateFractional function is its own concern - a separate, Private function would work, but I'd recommend making it Public, and unit-testing it to make sure it works as intended given a wide variety of edge-case inputs - and having it in a separate function means the logic in GetCasingSize doesn't need to change if the validation needs to be fine-tuned; for example this naive implementation uses the Like operator and would work for 5-1/4, but not for e.g. 15-5/8:
Public Function ValidateFractional(ByVal value As String) As Boolean
ValidateFractional = value Like "#[-]#/#"
End Function
Using Regular Expressions for this would probably be a good idea.
I'm trying to open UserForms based on the values of cells in one row of a sheet. There are 17 UserForms so I don't want to have to use 17 if statements for each form like this:
If ActiveCell.Value = 1 Then
UserForm1.Show
End If
Is there a way that I can use a variable to show the forms?
I was thinking something along the lines of:
Dim i
Do
If ActiveCell.Value = "" Then
Exit DO
End If
i = ActiveCell.Value
UserForms("UserForm" & i).Show ****THIS is what doesn't work
ActiveCell.Offset(0,1).Select
Loop
Paste the code from the link Harvey provided, then adjust this line in your code:
UserForms("UserForm" & i).Show ****THIS is what doesn't work
to:
ShowAnyForm ("UserForm" & i)
That's a great link Harvey, I've bookmarked it!
You can use the often overlooked VBA.UserForms object. See this link which fully descibes what you need to do.
There's no point in my explaining it here.
Harvey
I've never come accross the method mentioned by #Harvey (I like it, though) so would have used some sort of Select Case statement:
Select Case .Cells(1,1).Value
Case 1:
FormOne.Show
Case 2:
FormTwo.Show
' And so on and do forth...
Case Else:
MsgBox ("Invalid entry")
End Select
Simpler than 17 If statements, at least.
The easiest way is this one:
Dim activeuf as Object
Set activeuf = UserForm & i
activeuf.show
Perhaps it will not work for the person who asked, but I'm sure it will help people who check this question in the future
Get UserForm object defined by its string name
Function Form(Name As String) As Object
Set Form = CallByName(UserForms, "Add", VbMethod, Name)
End Function
Sub Test()
Dim strFormName As String
strFormName = "UserForm1" ' <-- replace by your lookup code instead
Form(strFormName).Show
End Sub
Here a "faster" code to open the form (Rao-Haribabu evolution):
Dim forMy
Set forMy = CallByName(UserForms, "Add", VbMethod, formName) ' formName is the form name to open
forMy.Show
Cell value of B6 = 'Trading Income
=VLOOKUP(B6,'\\myComp.myComp.com\abc\Treas\P&L\data\[DataUS.xls]Smith, Bob'!$A$1:$D$2000,2,FALSE)
This returns (5,555,529.00)
However, say I wanted to place
'\\myComp.myComp.com\abc\Treas\P&L\data\[DataUS.xls]Smith, Bob'!$A$1:$D$2000
in a cell (Lets say B7). How would I structure the VLOOKUP?
I tried:
VLOOKUP(B6, B7, 2, FALSE)
And it returns #N/A
Thank you
Try
=VLOOKUP(B6;'\\myComp.myComp.com\abc\Treas\P&L\data\[DataUS.xls]Smith, Bob'!$A$1:$D$2000;2;FALSE)
You have to use INDIRECT, see this.
In your case, use INDIRECT(B7) instead of B7.
Try this:
=VLOOKUP(B6, INDIRECT(B7), 2, FALSE)
Just ensure that cell B7 contains the exact path i.e. written exactly in the same manner it is written in the formula.
Now adding macros doe
sn't really increase the level of complexity, at least I have not seen any case as yet. On the contrary a macro, if done correctly, increase efficiency,
dependency and certainty of the results.
I suggest this solution which includes macros, provides the simplicity and flexibility of building the link to external data using a Name to hold the External Reference created using user input, which is split in the different parts of the external link to make it easier changes i.e. Path, Filename, Worksheet and Range.
This includes the creation of five Names to handle the linked formula, here is when you might feel like you got it right when mentioning “increasing the level of complexity”, however we can use the power and flexibility of macros not only to produce the expected outcome in a report, analysis, etc.; but also to build forms, reports, graphs, data, etc. and by using macros it also eliminates the need for insanity checks, which at times make us insane, providing and excellent tool to reinstate, review and even change the parameters of large projects when required.
The code provided below includes the creation of the Names, also the refresh the Name that holds the External Link Reference once the user changes any part of the external reference in the worksheet.
First we run this code to create the names (copy this in a module)
Option Explicit
Option Base 1
Sub FmlLnk_WshAddNames()
Const kRowIni As Byte = 2
Const kCol As Byte = 3
Const kWshTrg As String = "Sht(1)"
Dim aNames As Variant
aNames = fNames_Get
Dim WshTrg As Worksheet
Dim bRow As Byte
Dim b As Byte
Set WshTrg = ThisWorkbook.Worksheets(kWshTrg)
With WshTrg
For b = 1 To UBound(aNames)
bRow = IIf(b = 1, kRowIni, 1 + bRow)
.Names.Add Name:=aNames(b), RefersTo:=.Cells(bRow, kCol)
.Names(aNames(b)).Comment = "Name to create link to external range"
Next: End With
End Sub
Function fNames_Get() As Variant
fNames_Get = Array("_Path", "_Filename", "_Worksheet", "_Range")
End Function
Now that the Names to hold the parts of the external link are created we add the worksheet event to automatically update the name holding the External Link Reference (see https://msdn.microsoft.com/EN-US/library/office/ff198331.aspx)
To go to the event procedures for the Worksheet that contains the formula right-click the sheet tab and click “View Code” on the shortcut menu.
Copy the code below in the Worksheet code
Option Explicit
Option Base 1
Private Sub Worksheet_BeforeDoubleClick(ByVal RngTrg As Range, bCancel As Boolean)
Const kFmlLnk As String = "_FmlLnk"
Dim aNames As Variant, vName As Variant
aNames = fNames_Get
Dim WshThs As Worksheet
Dim bLnkExt As Boolean
Dim sLnkExt As String
Set WshThs = RngTrg.Worksheet
With WshThs
Application.Goto .Cells(1), 1
Rem Validate ActiveCell
bLnkExt = False
For Each vName In aNames
If .Names(vName).RefersToRange.Address = RngTrg.Address Then
bLnkExt = True
Exit For
End If: Next
Rem Reset Name Link External
If bLnkExt Then
Rem Built External Formula Link
sLnkExt = "=" & Chr(39) & .Names(aNames(1)).RefersToRange.Value2 & _
"[" & .Names(aNames(2)).RefersToRange.Value2 & "]" & _
.Names(aNames(3)).RefersToRange.Value2 & Chr(39) & Chr(33) & _
.Names(aNames(4)).RefersToRange.Value2
Rem Add External Formula Link Name
.Names.Add Name:=kFmlLnk, RefersTo:=sLnkExt
.Names(kFmlLnk).Comment = "Name to link external range in Formula"
End If: End With
End Sub
This procedure will run every time the users double-clicks in any of the four Names created in the worksheets that holds the External Link Formula
The Formula to use the external link name is:
=VLOOKUP($B9,_FmlLnk,3,0)
Sub Sales_Summary_Macro()
Dim strMake, strModel, strCount As String
Dim makeLoc, modelLoc, countLoc As Integer
strMake = Application.InputBox("Make")
strModel = Application.InputBox("Model")
strCount = Application.InputBox("Count")
If strMake <> False Then
Debug.Print strMake
Debug.Print strModel
Debug.Print strCount
makeLoc = WorksheetFunction.Match(strMake, Range("A1:A10"), 0)
Debug.Print makeLoc
End If
End Sub
I just want to take the string input of the user on three different variables and find the column that contains each variable. I have tried Application.Match() and Match() alone and neither seem to work.
Not going full technical and will not post code. However, three things:
One, make sure your ranges are always fully qualified. For example, Range("A1:A10") is not nearly enough. You should specify on which sheet this should be located. If you are calling this macro from another sheet, it will give you a wrong result or throw an error.
Two, without going to too much details:
Application.Match returns an error value if there's no match found. This can be handled using IsError, which is what simoco did in his answer.
WorksheetFunction.Match throws a 1004 error when it doesn't find an error. This is not the same as returning a value. As such, this is (slightly) harder to handle.
Best practice is to always use the first one.
Three, the immediate window in VBE is your best friend. A simple ?Application.Match("FindMe", [A1:A10], 0) in the window can help you check if your formula is netting a similarly intended result.
As shown in the screenshot above, no string is found and an error value is returned.
Hope this helps!
UPD:
Is it possible to get it to return the cell reference like C1 and then use that cell reference in other functions
Sub Sales_Summary_Macro()
Dim strMake As String, strModel As String, strCount As String
Dim makeLoc, modelLoc As Integer, countLoc As Integer
Dim res As Range
strMake = Application.InputBox("Make")
strModel = Application.InputBox("Model")
strCount = Application.InputBox("Count")
If strMake <> "False" Then
Debug.Print strMake
Debug.Print strModel
Debug.Print strCount
On Error Resume Next
'Set res = Range("A1:Z1").Find(What:=strMake, LookAt:=xlWhole, MatchCase:=False)
Set res = Application.Index(Range("A1:A10"), Application.Match(strMake, Range("A1:A10"), 0))
On Error GoTo 0
If res Is Nothing Then
MsgBox "Nothing found!"
Exit Sub
End If
'Print address of result
Debug.Print res.Address
makeLoc = res.Value
Debug.Print makeLoc
End If
End Sub
BTW,
when you are using Dim strMake, strModel, strCount As String, only strCount has type String, but strMake, strModel are Variant.
The same thing with Dim makeLoc, modelLoc, countLoc As Integer - only countLoc has Integer type.
This is not a direct answer to the OP, but people (like me) may find this question helpful when trying to TRAP an error with vba Match. Typically I would use this to test if a value exists in an array.
It's quite maddening when using Application.Worksheetfunction.Match and being unable to capture a True with IsError when a value doesn't exist. Even the WorksheetFunction error handlers (iserr, isNA, etc) will not capture this as True and instead throws the VBA error of 1004 Unable to get the Match Property.
This is resolved by using Application.Match instead of Application.WorksheetFunction.Match. This is most counterintuitive as Match doesn't appear in the intellisense after typing Application. nor does Application.Match( display prompts for what fields to enter.
Meanwhile using Application.WorksheetFunction.Match does auto-populate with prompts which understandably can inspire users to take this approach and then be confused why they can't successfully trap an error.
The scenario:
Word documents that contain a selection of sentences (strings). There might be up to 30 possible strings (which vary from 5 to 20 words in length). The document will contain only a selection of these strings.
Aim:
Macro that searches through the document, finds each occurrence of a particular string and inserts a specific text code (such as " (ACWD2553)") after each occurrence. This is repeated for all the other strings in the set, with each different string having it's own distinct code. Some strings won't be in the document. The strings can be located in document body and table cells.
The macro would then be applied to other documents which would have different selections of the strings.
I have tried for many days using selection.find, content.find, target.list, insertafter and so on but only with one case and still ran into numerous problems (e.g. only inserting in one instance, or code repeatedly inserting until Word freezes).
Bonus feature ###
Be able to choose which set of strings which will be searched for (there are potentially up to 60 sets) and their corresponding codes. Each document would only have strings from one set.
An idea I had was for the strings to be listed in a column (in Excel?) and the matching codes in the a second column. The macro would then search the document for each string in the list (stopping at the end of the list since the number of strings varies between sets) finds the matching code in the cell in the next column and then inserts the code for each occurrence of the string in the word doc. When a different set is required, the Excel file could be swapped with the file containing the relevant set of stings, but with the same file name. Or all sets in the one Excel file on different worksheets and tab name entered in Word (userform?) which forces search of relevant set. This file would be located on a network drive.
Not sure if this is bigger then Ben Hur, last bit would be nice, but I can also manually enter the strings in the raw code from a template code.
Edited this post to include my poor attempt at the code. See my comment below. I just realised that I could add code to this pane. Tried a variety of iterations of the one below, none of which worked well and which does not approach what I require. I know there are obvious errors, as I said below I have played around with the code and made it worse in the process by mixing bits and pieces together.
Sub Codes()
Dim range As range
Dim i As Long
Dim TargetList
TargetList = Array("This is sentence 1", "This is string 2 which could be twenty words in length", "This is string three, there could be thirty more strings to search") ' put list of terms to find here
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.Find.Execute
range.InsertAfter Text:=" (ACWD1234)"
Loop
End With
Next
End Sub
I think that this is a time to use replace rather than find, see implementation below. If the specific code changes depending on the target string you can hanlde this easily with a 2 dimensional array
Sub Codes()
Dim i As Long
Dim TargetList
Dim MyRange As range
TargetList = Array("This is sentence 1", "This is string 2 which could be twenty words in length", "This is string three, there could be thirty more strings to search") ' put list of terms to find here
Dim sStringToAdd As String
sStringToAdd = " (ACWD2553)"
For i = 0 To UBound(TargetList)
Set MyRange = ActiveDocument.Content
MyRange.Find.Execute FindText:=TargetList(i), ReplaceWith:=TargetList(i) & sStringToAdd, _
Replace:=wdReplaceAll
Next i
End Sub
The code below does exactly what you need. I dont know if replacing the whole Contents property of the document object has some weird effect into tabulation/formating and so on.
I'd rather not add any overhead with string/array/collection manipulations. Using find-replace is probably the most obvious route, but I don't like that whole lot of options you need to set (because I understand none of them =P)
You need to add a reference to "Microsoft scripting runtime"
Public Sub changeTokens()
Dim strContents As String
Dim mapperDic As Scripting.Dictionary
Dim thisTokenKey As String
Dim varKey As Variant
Set mapperDic = getTokenMapper()
For Each varKey In mapperDic.Keys
thisTokenKey = CStr(varKey)
ThisDocument.Content = Replace(ThisDocument.Content, thisTokenKey, mapperDic(thisTokenKey))
Next varKey
End Sub
Public Function getTokenMapper() As Scripting.Dictionary
' This function can fetch data from other sources to buidl up the mapping.
Dim tempDic As Scripting.Dictionary
Set tempDic = New Scripting.Dictionary
Call tempDic.Add("Token 1", "Token 1 changed!!")
Call tempDic.Add("Token 2", "Token 1 changed!!")
Call tempDic.Add("Token 3", "Token 1 changed!!")
Set getTokenMapper = tempDic
End Function
You can fetch your data to create the mapper dictionary from a excel worksheet with no problems.
Thanks to the two respondents. I don't have the skillset to progress the second code. I ended up searching for reading data from Excel into a word document and found code that worked perfectly.
Using Excel as data source in Word VBA
http://social.msdn.microsoft.com/Forums/office/en-US/ca9a31f4-4ab8-4889-8abb-a00af71d7307/using-excel-as-data-source-in-word-vba
Code produced by Doug Robbins.
This worked an absolute treat.
Also it means that I can edit the Excel file for the different sets of statements and their matching codes. Now it would be particularly sweet if I could work out a way to create a userform that would open when i run the macro and select the appropriate woprksheet based on the userform dropdown list item selected.