formula leaving whitespace - vba

I have the following formula designed to flag rows in a ListObject:
=IF( [#[Is Closed]]="Y", "", "Y")
I have some vba code that looks for these value via StrCmp, and was surprised to find that the Text property of the cell was " Y " (as opposed to "Y").
There are some obvious easy work arounds but can someone explain why the formula is leaving whitespace and how to force it not to?
Cheers,
UPDATE
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAllInColumn
' To find a value regardless of hidden rows and autofulter settings that can make
' other methods unreliable
'
' aSearchRange : the range of data to search, which MUST be a single column
' aLookUpVal : the value
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function FindAllInColumn(aSearchRange As Range, aLookUpVal As Variant) As Excel.Range
Debug.Assert aSearchRange.Columns.Count = 1
Dim rngEach As Range
Dim rngResult As Excel.Range
For Each rngEach In aSearchRange
' Debug.Print rngEach.Address & ": Value " & rngEach.Text
' If IsValued(rngEach.Text) Then Stop
If (StrComp(rngEach.Text, aLookUpVal) = 0) Then
If rngResult Is Nothing Then
Set rngResult = rngEach
Else
Set rngResult = Application.Union(rngResult, rngEach)
End If
End If
Next rngEach
Set FindAllInColumn = rngResult
End Function
The FIX
StrComp(rngEach.Value2, aLookUpVal, vbTextCompare)
Changing .Text to .Value2 instead. Odd, but at least it works now

In general empty spaces in Excel sometimes cause a lot of problems. As the OP has found out himself, .Value2 seems like a universal problem-solver of many strange cases.
Try to select the cell and check the following code, it will print possible "hidden" empty spaces:
Option Explicit
Public Sub TestMe()
Dim rng As Range
Dim cnt As Long
Set rng = Selection
For cnt = 1 To Len(rng)
Debug.Print Asc(Mid(rng, cnt, 1))
Next cnt
End Sub

Related

VBA code to only show rows that contain similar text to an input field?

I'm new to VBA and am trying to cobble together some code to allow a user to input a word (or several words) into a cell and then show a list of matching row entries.
I have tried the following code but am getting an "instring = type mismatch" error.
Note that "B3" is the field dedicated for the "search word" and column F is the column containing the text I want to search within. If the word is contained, I want to show that row and hide all rows that don't contain that word.
Sub Find_Possible_Task()
ROW_NUMBER = 0
SEARCH_STRING = Sheets("codeset").Range("B3")
ROW_NUMBER = ROW_NUMBER + 1
ITEM_IN_REVIEW = Sheets("codeset").Range("F:F")
If InStr(ITEM_IN_REVIEW, SEARCH_STRING) Then
Do
Cells(c.Row).EntireRow.Hidden = False
Loop Until ITEM_IN_REVIEW = ""
End If
End Sub
TIA!
Few bad coding conventions or even possibly downright errors:
It's a good practice to explicity declare the scope Public/Private of your Sub procedure
Unless you're passing the variables from some place else, they need to be declared with Dim keyword
Using Option Explicit will help you prevent aforementioned error(s)
(Subjective) variables in all caps are ugly and in most programming languages it is convention to reserve all caps variables names for constants (Const)
Option Explicit
Private Sub keep_matches()
Dim what As Range
Dim where As Range
Dim res As Range ' result
Dim lr As Long ' last active row
Dim ws As Worksheet: Set ws = Sheets("codeset")
lr = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
Set what = ws.Range("B3")
Set where = ws.Range("F1:F" & lr)
' we'll create an extra column for a loop in our .Find method
where.Copy
ws.Range("F1").EntireColumn.Insert
ws.Range("F1").PasteSpecial xlPasteValues
where.EntireRow.Hidden = True ' preemptively hide them all
Set where = ws.Range("F1:F" & lr)
Set res = where.Find(what, lookIn:=xlValues) ' ilook for matches, 1st attempt
If Not res Is Nothing Then ' if found
Do Until res Is Nothing ' repeat for all results
res.EntireRow.Hidden = False
res = "Checked"
Set res = where.FindNext(res)
Loop
Else
MsgBox("No matches were found")
where.EntireRow.Hidden = False ' we don't wanna hide anything
End If
ws.Range("F1").EntireColumn.Delete ' remove the extra help column for Find method
End Sub
Should work as expected.
If there are any question, let me know.
instead of instr(), consider range.find().
Sub Find_Possible_Task()
Dim SEARCH_STRING As String
Dim ITEM_IN_REVIEW As Range
Dim found As Range
Dim i As Integer
SEARCH_STRING = Sheets("Sheet1").Range("B3").Value
i = 1
Do
Set ITEM_IN_REVIEW = Sheets("Sheet1").Cells(i, 6)
Set found = ITEM_IN_REVIEW.Find(What:=SEARCH_STRING)
If found Is Nothing Then
ITEM_IN_REVIEW.EntireRow.Hidden = True
End If
i = i + 1
Loop Until ITEM_IN_REVIEW = ""
End Sub
alternatively, consider using filter table:
1. check if your table has filter on ==> if yes, pass. if no, turn on filter.
2. filter column F for keyword to contain value in cell B3.

How to get the count of the find results in vba

I have written a code to count the number of occurrence of the find results, the problem i am facing is., if the find data is more than 255 characters the code is returning count as '0' although we have some matches, where as for those find data which are less than 255 the code is properly working and fetching the right count.
Can anyone please rectify the issue, below is the code.
Sub CommentCount()
Dim CSAT_Comments As Workbook
Dim comment As Worksheet
Dim match As Worksheet
Dim CommentString As String
Dim MatchRow As Integer
Set CSAT_Comments = ActiveWorkbook
Set comment = CSAT_Comments.Worksheets("Qualitative Analysis_2018 Cycle")
Set match = CSAT_Comments.Worksheets("Consolidated Comments")
Dim CommentRange As Range
match.Range("A2").Select
Dim CRange As Range
Dim DuplicateCount As Integer
Set CommentRange = match.Range(Selection, Selection.End(xlDown)) 'Defining the range
For Each CRange In CommentRange.SpecialCells(xlCellTypeVisible)
CommentString = Left(CRange.Value, 255) 'Store the first 225 characters of the string
MatchRow = CRange.Row 'To get the row number of the respective comments
With comment
Application.ScreenUpdating = False
.Activate
Columns("AK:BL").Select 'Range which needs to be searched
DuplicateCount = Application.WorksheetFunction.CountIf(Range("AK:BL"), "" & CommentString) ' To get the count of find result and here is where i am getting the problem when the search string is >255
With match
.Activate
.Range("B" & MatchRow) = DuplicateCount 'Paste the count in the against respective commments
End With
End With
Next CRange
End Sub
use
CommentString = Left(CRange.Value, 254) & "*" 'Store the first 254 characters of the string, leaving the 255th character for final asterisk

How to set a different link in each cell in a range?

I'm programming a Macro in VB for Excel 2013 that search for coincidences in different worksheets, and add a link to the cells that match.
I'm havin torubles to insert the link in the cell, since the link must be different for a range of cells, I need help here.
Here is my code
Dim bufferDetails As String
Dim tmpCell As String
Dim spot As String
Dim cell As Variant
Dim cellSpots As Variant
For Each cell In Worksheets("MMS-Locations").Range("D2:D1833")
If (cell.Value2 = "NULL") Then
cell.Value2 = "NULL"
Else
tmpCell = cell.Text
'A62
If (Left(tmpCell, 3) = "A62") Then
spot = spotName(tmpCell)
For Each cellSpots In Worksheets("DetailedMap").Range("G60:CF123")
If (cellSpots.Value2 = spot) Then
For Each linkToSpot In Worksheets("MMS-Locations").Range("H2:H1833")
Worksheets("MMS-Locations").Hyperlinks.Add _
Anchor:=Range(linkToSpot), _
Address:="http://example.microsoft.com", _
ScreenTip:="Microsoft Web Site", _
TextToDisplay:="Microsoft"
Next linkToSpot
Debug.Print ("Encontrado " + cellSpots)
End If
Next cellSpots
End If
End If
Next cell
End Sub
Function spotName(fullName As String) As String
Dim realSpot As String
Dim lenght As Integer
lenght = Len(fullName) - 3
realSpot = Right(fullName, lenght)
spotName = realSpot
End Function
As I was thinking the linkToSpot variable contains the actual cell in the range, so I can move my selection of the sell, but my code fails in there with this error:
Error in the Range method of the '_Global' object,
Just for reference, here is what I use to convert a phone number to an email for texting..setting it as a hyperlink in the current cell.
ActiveCell.Value = myNumbr
Set myRange = ActiveCell
ActiveSheet.Hyperlinks.Add anchor:=myRange, Address:="mailto:" & myRange.Value, TextToDisplay:=myRange.Value`
Keep your code simple to start with, until you find a working script, then add other items. Make good use of the F8 key to step through your code to find out exactly where an error occurs.

Excel VBA .find matches when there is no match

I am attempting to find if a value in a cell matches the list of values in a named range that defines the dropdown for the cell.
My problem is if the user enters an asterik in the cell, this value is not a valid dropdown value but it validates to the first item in the list. In the code below, if szCellValue = "*" then the validation does not work.
Does anyone know how to get this search to work?
Range Values
DESK
ON-SITE
N/A
Code to determine the match
Dim bError As Boolean
Dim oCell As Range
Dim oFoundCell As Range
Dim szCellValue As String
Dim szLookupValue As String
szCellValue = CStr(Trim(oCell.Value2))
' Validate In Dropdown if Length > 0
If Len(szCellValue) > 0 Then
' See if the oCell value in the oRange loop exists in this szValidationNamedRange dropdown
Set oFoundCell = GetRangeFromNamedRange(cValidateCellData.ValidationNamedRange).Find(szCellValue, LookIn:=xlValues, Lookat:=xlWhole)
' If Value Not Found in Dropdown...or if they've typed in an id value (which will be found on odd numbered columns)
If oFoundCell Is Nothing Then
Call SetError(oCell.Text, cValidateCellData, "Not a Valid Value for drop down " + cValidateCellData.ValidationNamedRange + ".")
bError = True
End If
Else
If cValidateCellData.Required Then
Call SetError(oCell.Text, cValidateCellData, "Please input a value. This is a Required Field.")
End If
End If
You can use ~ to escape the asterisk.
Eg:
Dim bError As Boolean
Dim oCell As Range
Dim oFoundCell As Range
Dim szCellValue As String
Dim szLookupValue As String
szCellValue = CStr(Trim(oCell.Value2))
' Validate In Dropdown if Length > 0
If Len(szCellValue) > 0 Then
' See if the oCell value in the oRange loop exists in this szValidationNamedRange dropdown
' (escape * using ~)
Set oFoundCell = GetRangeFromNamedRange(cValidateCellData.ValidationNamedRange) _
.Find(Replace(szCellValue, "*", "~*"), LookIn:=xlValues, Lookat:=xlWhole)
' If Value Not Found in Dropdown...or if they've typed in an id value
' (which will be found on odd numbered columns)
If oFoundCell Is Nothing Then
Call SetError(oCell.Text, cValidateCellData, _
"Not a Valid Value for drop down " & cValidateCellData.ValidationNamedRange & ".")
bError = True
End If
Else
If cValidateCellData.Required Then
Call SetError(oCell.Text, cValidateCellData, _
"Please input a value. This is a Required Field.")
End If
End If

In a specific row of a table replace a "*" with a checked checkbox, and "" with a checkbox that is not checked

I have a couple of tables and want to replace column 2 or column 5 (if it exists) with check boxes.
If there is an asterisk in the cell, I want the check box checked = True.
If there's no asterisk, the cell will only be a unchecked check box. These check boxes are from the developer tab, under controls, legacy forms.
I researched but failed:
replacing an asterisk with a check box (checked)
limiting it to a specific column (see image)
replacing a blank cell with a check box (unchecked)
limiting the action to a specific column (2 and 5 (if it exists))
Dim oCell As Cell
Dim oRow As Row
For Each oRow In Selection.Tables(1).Rows
For Each oCell In oRow.Cells 'this won't work specifically with my example, needs to be a little more specific
If oCell.Range.Text = "*" Then
MsgBox oCell.RowIndex & ", " & oCell.ColumnIndex & " check it!"
'I don't how to put in a check box here
End If
Next oCell
Next oRow
'I want to combine the top code and code below...right?
'do for each cell in column 2
With ActiveDocument.FormFields.Add(Range:=ActiveDocument.Selection, Type:=wdFieldFormCheckBox)
If cellvalue = "" Then 'just verbal logic here
.CheckBox.Value = False
End If
If cellvalue = "*" Then 'just verbal logic here
.checkbox.Value = True
End If
End With
Here's how I would do this:
Dim objDoc As Document
Dim oCell As Cell
Dim oCol As Column
Dim objTable As Table
Dim bFlag As Boolean
Set objDoc = ActiveDocument
Set objTable = Selection.Tables(1)
'This may or may not be necessary, but I think it's a good idea.
'Tables with spans can not be accessed via the spanned object.
'Helper function below.
If IsColumnAccessible(objTable, 2) Then
For Each oCell In objTable.Columns(2).Cells
'This is the easiest way to check for an asterisk,
'but it assumes you have decent control over your
'content. This checks for an asterisk anywhere in the
'cell. If you need to be more specific, keep in mind
'that the cell will contain a paragraph return as well,
'at a minimum.
bFlag = (InStr(oCell.Range.Text, "*") > 0)
'Delete the content of the cell; again, this assumes
'the only options are blank or asterisk.
oCell.Range.Delete
objDoc.FormFields.Add Range:=oCell.Range, Type:=wdFieldFormCheckBox
'Set the value. I found some weird results doing this
'any other way (such as setting the form field to a variable).
'This worked, though.
If bFlag Then
oCell.Range.FormFields(1).CheckBox.Value = True
End If
Next oCell
End If
'Then do the same for column 5.
Public Function IsColumnAccessible(ByRef objTable As Table, iColumn As Integer) As Boolean
Dim objCol As Column
'This is a little helper function that returns false if
'the column can't be accessed. If you know you won't have
'any spans, you can probably skip this.
On Error GoTo IsNotAccessible
IsColumnAccessible = True
Set objCol = objTable.Columns(iColumn)
Exit Function
IsNotAccessible:
IsColumnAccessible = False
End Function