I am working on a Function that takes two different cells and looks for
them in a column of strings that is in a different sheet:
Sub search_cellID()
'
'
' Print argument should be written in V7
Range("V7").Select
'flag for the loop
i = 2
if Instr( -16, 'Input'!RiC11,1 ) = -16 Then
Print 'Input'!RiC2
Elseif Instr( -1, 'Input'!RiC11) = -1 Then
Print 'Input'!RiC2
Else: i = i + 1
End If
End Sub
Nevertheless, I am not getting the syntax right. Sorry, I am very new at VBA and trying to figure it out.
You can't do it in this way because there are several errors. For example, you should first work with debug.print.
InStr returns a Variant (Long) specifying the position of the first occurrence of one string within another.
Syntax: InStr([ start ], string1, string2, [ compare ])
The example below uses the InStr function to return the position of the first occurrence of one string within another.
Dim SearchString, SearchChar, MyPos
SearchString ="XXpXXpXXPXXP" ' String to search in.
SearchChar = "P" ' Search for "P".
' A textual comparison starting at position 4. Returns 6.
MyPos = Instr(4, SearchString, SearchChar, 1)
' A binary comparison starting at position 1. Returns 9.
MyPos = Instr(1, SearchString, SearchChar, 0)
' Comparison is binary by default (last argument is omitted).
MyPos = Instr(SearchString, SearchChar) ' Returns 9.
MyPos = Instr(1, SearchString, "W") ' Returns 0.
Copied from: InStr function
For a first start you may want to have a look at:
Private Sub CommandButton1_Click()
Dim cell As Range
For Each cell In Range("b2:b6")
If InStr(cell.Value, "Dr.") > 0 Then
cell.Offset(0, 1).Value = "Doctor"
End If
Next cell
End Sub
Related
I would like to print each substrings in between the "..." from this string: "...covid...is...very...scary" in consecutive cells in a column in excel.
this is my code in VBA.
Sub copyd()
findandcopy("...covid...is...very...scary") 'not sure how to print in consecutive cells of a column
End Sub
Function findandcopy(brokenstr As String) As String
Dim first, second As Integer
Dim strtarget as string
strtarget = "..."
Do until second =0. 'second=0 so that loop ends when there is no more "..." found
first = InStr(brokenstr, strtarget)
second = InStr(first + 3, brokenstr, strtarget)
findandcopy = Mid(purpose, first +3, second - first -3) 'referred to https://stackoverflow.com/questions/2543225/how-to-get-a-particular-part-of-a-string#_=_
first = second 'so that loop can find next "..."
Loop
End Function
can anyone please advise? thank you for your help :)
Try this code:
Option Explicit
Sub copyd()
Dim arr As Variant
' get splitted text into horizontal array arr()
arr = Split("...covid...is...very...scary", "...")
If UBound(arr) > 0 Then ' if there is something in the array, display it on the sheet
' put onto sheet values from transposed array arr()
ThisWorkbook.Worksheets(1).Range("A1"). _
Resize(UBound(arr) + 1, 1).Value = _
WorksheetFunction.Transpose(arr)
End If
End Sub
Ahh, why not just split the string by "..."?
Like:
Function findandcopy(brokenstr As String, targetStr as string)
dim substr()
if instr(1, brokenstr, targetStr, vbTextCompare) > 0 then
'brokenstr has at least one instance of targetStr in it
brokenstr2 = split(brokenstr,targetStr)
if brokenstr2(0) = "" then
redim substr(ubound(brokenstr2)-1)
iStart = 1
else
redim substr(ubound(brokenstr2))
iStart = 0
end if
for i = iStart to ubound(brokenstr2)
substr(i-iStart) = brokenstr2(i)
next i
else
'No instances of targetStr in brokenstr
redim substr(0)
substr(0) = brokenstr
end if
findandcopy = substr
end function
Which will return an array of strings which are the bits between targetStr. Then you can do with it as you please within the parent sub.
If you start doing comparisons with the results and find issues - you can remove whitespace by modifying above as:
substr(i) = trim(brokenstr2(i))
and your calling code:
Sub main()
Dim covid as string
Dim remove as string
covid = "...covid...is....very...scary"
'covid = "really...covid...is...very...scary" 'For testing
remove = "..."
rtn = findandcopy(covid, remove)
end sub
For example, our cell contains:
EWFS 410461, 501498, EFW406160
So, I need the formula that gets back with
410461 501498 406160
Consider the following User Defined Function:
Public Function GetNumbers(s As String) As String
Dim L As Long, i As Long, wf As WorksheetFunction
Set wf = Application.WorksheetFunction
L = Len(s)
For i = 1 To L
If Mid(s, i, 1) Like "[A-Z]" Or Mid(s, i, 1) = "," Then Mid(s, i, 1) = " "
Next i
GetNumbers = wf.Trim(s)
End Function
All numbers will be returned as a space-separated string
If you have Office 365 you can use this array formula:
=TEXTJOIN(" ",TRUE,IF((ISNUMBER(--MID(A1,ROW($XFD$1:INDEX(XFD:XFD,LEN(A1)-5)),6)))*(NOT(ISNUMBER(--MID(A1&";",ROW($XFD$1:INDEX(XFD:XFD,LEN(A1)-5)),7)))),MID(A1,ROW($XFD$1:INDEX(XFD:XFD,LEN(A1)-5)),6),""))
Being an array formula it must be confirmed with Ctrl-Shift-Enter instead of Enter when exiting Edit Mode.
If "E", "W", "F" and "S" are the only letters you must get rid of, you can avoid VBA and use SUBSTITUTE() function:
=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(B2,"E",""),"W",""),"F",""),"S",""),",",""))
a slight variation of Gary's Student's answer:
Public Function GetNumbers2(s As String) As String
Dim i As Long, elem As Variant
For Each elem In Split(s, ",")
For i = 1 To Len(elem)
If Mid(elem, i, 1) Like "[0-9]" Then Exit For
Next i
GetNumbers2 = GetNumbers2 & " " & Application.WorksheetFunction.Trim(Mid(elem, i))
Next
GetNumbers2 = Trim(GetNumbers)
End Function
This answer isn't better than the others with positive scores, but I prefer using ASCII codes for handling characters in a string. This enables ranges that organize cleanly with Select Statements. This is especially useful for rejecting characters from unsophisticated users like my parents (I did not name their grandson "4").
Below is a UDF that would work for the OP, but also shows how one could leverage the VBA Asc function combined with a select statement for handling, upper/lower case, or any other specific characters:
Public Function GiveTheNumbers(theINPUT As String) As String
Dim p As Long, aCode As Long
For p = 1 To Len(theINPUT)
aCode = Asc(Mid(theINPUT, p, 1)) 'converts string to an ascii integer
Select Case aCode
'32 is the ascii code for space bar. 48 to 57 is zero to nine.
Case 32, 48 To 57
GiveTheNumbers = GiveTheNumbers & Chr(aCode) 'Chr() converts integer back to string
'the rest of these cases are not needed for the OP but I'm including for illustration
Case 65 To 90
'all upper case letters
Case 97 To 122
'all lower case letters
Case 33, 64, 35, 36, 37, 42
'my favorite characters of: !##$%*
Case Else
'anything else
End Select
Next p
End Function
NDIGITS (UDF)
Excel Formula
=NDIGITS($A1,6)
Sample Data
VBA Code
'******************************************************************************
' Purpose: From a string, returns digit groups (numbers) in a delimited
' string.
' Inputs
' SourceString - Required. The string to be checked for digits.
' NumberofDigits - Optional. The number of digits in digit groups. If 0,
' all digit groups are returned. Default: 0.
' TargetDelimiter - Optional. The delimiter of the returned string.
' Default: " " (space).
'******************************************************************************
Function NDigits(ByVal SourceString As String, _
Optional ByVal NumberOfDigits As Long = 0, _
Optional ByVal TargetDelimiter As String = " ") As String
Dim i As Long ' SourceString Character Counter
Dim strDel As String ' Current Target String
' Check if SourceString is empty (""). Exit if. NDigits = "".
If SourceString = "" Then Exit Function
' Loop through characters of SourceString.
For i = 1 To Len(SourceString)
' Check if current character is not a digit (#), then replace with " ".
If Not Mid(SourceString, i, 1) Like "#" Then _
Mid(SourceString, i, 1) = " "
Next
' Note: While VBA's Trim function removes spaces before and after a string,
' Excel's Trim function additionally removes redundant spaces, i.e.
' doesn't 'allow' more than one space, between words.
' Remove all spaces from SourceString except single spaces between words.
strDel = Application.WorksheetFunction.Trim(SourceString)
' Check if current TargetString is empty (""). Exit if. NDigits = "".
If strDel = "" Then Exit Function
' Replace (Substitute) " " with TargetDelimiter if it is different than
' " " and is not a number (#).
If TargetDelimiter <> " " And Not TargetDelimiter Like "#" Then
strDel = WorksheetFunction.Substitute(strDel, " ", TargetDelimiter)
End If
' Check if NumberOfDigits is greater than 0.
If NumberOfDigits > 0 Then
Dim vnt As Variant ' Number of Digits Array (NOD Array)
Dim k As Long ' NOD Array Element Counter
' Write (Split) Digit Groups from Current Target String to NOD Array.
vnt = Split(strDel, TargetDelimiter)
' Reset NOD Array Element Counter to -1, because NOD Array is 0-based.
k = -1
' Loop through elements (digit groups) of NOD Array.
For i = 0 To UBound(vnt)
' Check if current element has number of characters (digits)
' equal to NumberOfDigits.
If Len(vnt(i)) = NumberOfDigits Then
' Count NOD Array Element i.e. prepare for write.
k = k + 1
' Write i-th element of NOD Array to k-th element.
' Note: Data (Digit Groups) are possibly being overwritten.
vnt(k) = vnt(i)
End If
Next
' Check if no Digit Group of size of NumberOfDigits was found.
' Exit if. NDigits = "".
If k = -1 Then Exit Function
' Resize NOD Array to NOD Array Element Count, possibly smaller,
' due to fewer found Digit Groups with the size of NumberOfDigits.
ReDim Preserve vnt(k)
' Join elements of NOD Array to Current Target String.
strDel = Join(vnt, TargetDelimiter)
End If
' Write Current Target String to NDigits.
NDigits = strDel
End Function
'******************************************************************************
' Remarks: A digit group are consecutive numbers in the string e.g.
' in the string "123 sdf jk 23 4" there are three digit groups:
' The 1st is 123 with NumberOfDigits = 3, the 2nd is 23 with
' NumberOfDigits = 2 and finally 4 with NumberOfDigits = 1. Since
' they all have a different number of digits, all will be returned
' if NumberOfDigits is 0 or omitted, otherwise only one will be
' returned.
'******************************************************************************
use Right() function and get 6 rightmost character. for example:
Right(cell.Value, 6)
where cell is some Range variable addressing relevant cell
for instance
Dim cell As Range
For Each cell In Range("B2:D2") ' change "B2:D2" to your actual range woth values
Debug.Print Right(cell.Value, 6)
Next
I have an excel sheet with some rows of descriptions in a single column, what I am aiming is to get a vba that would go though all those rows of descriptions and truncate it upto certain character limit for example 30 characters and if the truncation stops at 30 character in the middle of the word then I want the complete word(could extend beyond 30 characters in this case).
I tried to do this with the VBA code below, but I am not able to get what I am looking for.
Function foo(r As Range)
Dim sentence As Variant
Dim w As Integer
Dim ret As String
' assign this cell's value to an array called "sentence"
sentence = Split(r.Value, " ")
' iterate each word in the sentence
For w = LBound(sentence) To UBound(sentence)
' trim to 6 characters:
sentence(w) = Left(sentence(w), 6)
Next
' Join the array back to a string/sentence
ret = Join(sentence, " ")
'Make sure the sentence is max 20 chars:
ret = Left(ret, 20)
'return the value to your function expression:
foo = ret
End Function
I expect the code to go through all the rows of a specific column and truncate it upto 30 characters and if the truncation stops in the middle of the word, then it should keep that word.
Since you tagged it for a formula
=LEFT(A1,FIND(" ",A1,30)-1)
I think you're looking for the instr() function. This could give you the first space-character after position 30.
You would get the following:
Dim SpacePosition as Integer
'return the position for the first space-character after position 29
SpacePosition = Instr(30, r.value," ")
if SpacePosition <> 0 then
'fill ret with the substring up to the first space after position 29
ret = left(r.value, SpacePosition - 1)
else
'if there is no space-character (after position 29) then take the whole string
ret = r.value
end if
Hope that helps.
Best & brilliant solution by #scott Craner. However, In you VBA code you may Change the followings to get required result
'Join the array back to a string/sentence
'ret = Join(sentence, " ")
ret = ""
For w = LBound(sentence) To UBound(sentence)
' trim to 6 characters:
sentence(w) = Left(sentence(w), 6)
ret = ret & IIf(Len(ret) > 0, " ", "") & sentence(w)
If Len(ret) >= 30 Then Exit For
Next w
'Make sure the sentence is max 20 chars:
' ret = Left(ret, 20)
Public Function foo(r As Range, length As Integer) As String
If Len(r.Value) <= length Then
foo = r.Value
Else
foo = Left(r.Value, 1 + length)
foo = RTrim(Left(foo, InStrRev(foo, " ")))
End If
End Function
I suppose you would want to run that by passing 20 as the 2nd parameter
Loop rows from sheet 1, column A starting from row 1:
Option Explicit
Sub test()
Dim Lastrow As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 1 To Lastrow
'Insert Code
Next i
End With
End Sub
I have a spreadsheet where I want to have:
1) A source cell, which will have a string such as D2594D8-8.
You can see this is a string of hexadecimal digits without a delimiter except the single dash
2)a group of label and "target" cells where a macro will copy each individual hex digit from the source cell individually.
So an example would be:
Step 1: Enter into D1 the value: D2594D8-8
Step 2: Run the macro
Step 3: the values of the cells:
C4 updated to equal "D" (The first character from the source cell string)
D4 updated to equal "2" (The second character from the source cell string)
E4 updated to equal "5" (The thrid character from the source cell string)
etc....
I currently am trying:
Sub AssignData()
Dim wldData As Variant
UWParray = Array(Range("D1"))
Range("D4").Value = UWParray(0)
Range("D5").Value = UWParray(1)
Range("D6").Value = UWParray(2)
Range("D7").Value = UWParray(3)
End Sub
But that only gets me:
"Run-time error '9'
Subscript out or Range
and the result:
1 D2594D8-8
2
3
4
5
6
7
Any help would be appreciated!
Thanks in advance
Your code is taking the entire D1 value and putting it into the first position of the array, so when it goes to look for the second position, it doesn't exist--hence the "subscript out of range" error. The below code works.
Sub AssignData()
Dim wldData As Variant
Dim UWParray() As String
Dim i As Integer
ReDim UWParray(Len(Range("D1").Value))
For i = 0 To Len(Range("D1").Value)
UWParray(i) = Mid(Range("D1").Value, i + 1, 1)
Next
Range("D4").Value = UWParray(0)
Range("D5").Value = UWParray(1)
Range("D6").Value = UWParray(2)
Range("D7").Value = UWParray(3)
End Sub
A one liner :)
[c4].Resize(1, Len([d1].Value)) = Application.Transpose(Evaluate("=index(mid(D1,ROW(1:" & Len([d1].Value) & "),1),)"))
This should do what your asking:
Dim my_array() As String
Dim my_String As String
Dim i As Integer
my_String = Range("D1").Value
'Replace "-" with nothing
my_String = Replace(my_String, "-", "")
'Split my string into individual characters and store in array/worksheet
ReDim my_array(Len(my_String) - 1)
For i = 1 To Len(my_String)
my_array(i - 1) = Mid(my_String, i, 1)
'Store values in excel sheet starting at C3
Cells(4, (2 + i)).Value = my_array(i - 1)
Next
You actually don't need to use an array to store the values into the worksheet's cells, but I added it because of the post title.
I found code to convert number to column letter.
How can I convert from column letter to number?
Sub colLtr()
Dim mycolumn
mycolumn = 1000
Mcl = Left(Cells(1, mycolumn).Address(1, 0), InStr(1, Cells(1, mycolumn).Address(1, 0), "$") - 1)
MsgBox Mcl
End Sub
You can reference columns by their letter like this:
Columns("A")
So to get the column number, just modify the above code like this:
Columns("A").Column
The above line returns an integer (1 in this case).
So if you were using the variable mycolumn to store and reference column numbers, you could set the value this way:
mycolumn = Sheets("Sheet1").Columns("A").Column
And then you could reference your variable this way:
Sheets("Sheet1").Columns(mycolumn)
or to reference a cell (A1):
Sheets("Sheet1").Cells(1,mycolumn)
or to reference a range of cells (A1:A10)you could use:
Sheets("Sheet1").Range(Cells(1,mycolumn),Cells(10,mycolumn))
The answer given may be simple but it is massively sub-optimal, because it requires getting a Range and querying a property. An optimal solution would be as follows:
Function getColIndex(sColRef As String) As Long
Dim sum As Long, iRefLen As Long
sum = 0: iRefLen = Len(sColRef)
For i = iRefLen To 1 Step -1
sum = sum + Base26(Mid(sColRef, i)) * 26 ^ (iRefLen - i)
Next
getColIndex = sum
End Function
Private Function Base26(sLetter As String) As Long
Base26 = Asc(UCase(sLetter)) - 64
End Function
Some examples:
getColIndex("A") '-->1
getColIndex("Z") '-->26
getColIndex("AA") '-->27
getColIndex("AZ") '-->52
getColIndex("AAA") '-->703
To see the numerical equivalent of a letter-designated column:
Sub dural()
ltrs = "ABC"
MsgBox Cells(1, ltrs).Column
End Sub
My Comments
ARich gives a good solution and shows the method I used for a while but Sancarn is right, its not optimal. It's a little slower, will cause errors if the wrong input is given, and is not very robust. Sancarn is on the right track, but lacks a little error checking: for example, getColIndex("_") and getColIndex("AE"), will both return 31. Other non-letter characters (ex: "*") sometimes return various negative values.
Working Function
Here is a function I wrote that will convert a column letter into a number. If the input is not a column on the worksheet, it will return -1 (unless AllowOverflow is set to TRUE).
Function ColLetter2Num(ColumnLetter As String, Optional AllowOverflow As Boolean) As Double
'Converts a column letter to a number (ex: C to 3, A to 1, etc). Returns -1 if its invalid.
' #ColumnLetter - the letter(s) to convert to a number.
' #AllowOverflow - if TRUE, can return a number greater than the max columns.
On Error GoTo invalidCol
If Len(ColumnLetter) = 0 Then GoTo invalidCol
Dim thisChar As String
For i = 1 To Len(ColumnLetter) 'for each character in input
thisChar = Mid(ColumnLetter, i, 1) 'get next character
If Asc(UCase(thisChar)) >= 65 And Asc(UCase(thisChar)) <= 90 Then 'if the character is a letter
ColLetter2Num = ColLetter2Num + (26 ^ (Len(ColumnLetter) - i)) * (Asc(UCase(thisChar)) - 64) 'add its value to the return
Else
GoTo invalidCol 'if the character is not a letter, return an error
End If
If AllowOverflow = False And (ColLetter2Num = 0 Or ColLetter2Num > Columns.Count) Then
'if the value is not inside the bounds of the sheet, return an error and stop
invalidCol:
ColLetter2Num = -1 'error
Exit Function 'stop checking
End If
Next i
End Function
Examples
Sub test()
Debug.Print ColLetter2Num("A") 'returns 1
Debug.Print ColLetter2Num("IV") 'returns 256 (max columns for excel 2003 and prior))
Debug.Print ColLetter2Num("XFD") 'returns -1 (invalid because IV is the last column for .xls workbooks)
Debug.Print ColLetter2Num("XFD", True) 'returns 16384 (does not return -1 because AllowOverflow = TRUE)
Debug.Print ColLetter2Num("A_", True) 'returns -1 (invalid because "_" is not a column)
Debug.Print ColLetter2Num("132", True) 'returns -1 (invalid because "1" is not a column)
If ColLetter2Num("A") <> -1 Then
Debug.Print "The input is a valid column on the sheet."
Else
Debug.Print "The input is NOT a valid column on the sheet."
End If
End Sub