Can someone point me in the right direction with code or keywords to lookup? I am trying to concatenate, add email, and replace:
Example
Names
Example 1
FirstName1 LastName1, FirstName2 Lastname2, FirstName3 Lastname3
Into something like:
Example
Names
Example 1
FirstName1.LastName1#email.com, FirstName2,Lastname2#email.com, FirstName3.LastName3#email.com
Names will be separated by commas.
Thanks in advance!
Please, use the next function:
Function processNameMailAccount(x As String)
Dim arrNames, i As Long
Const domain As String = "#email.com"
arrNames = Split(x, ", ")
For i = 0 To UBound(arrNames)
arrNames(i) = Join(Split(arrNames(i)), ".") & domain
Next i
processNameMailAccount = Join(arrNames, ", ")
End Function
It can be used/tested in the next way:
Sub testprocessNameMailAccount()
Dim x As String
x = "FirstName1 LastName1, FirstName2 Lastname2, FirstName3 Lastname3"
Debug.Print processNameMailAccount(x)
End Sub
Supposing that the column having the names is "B:B" you can use the function to process as you need with a code like the next. For testing reasons, it returns in column "D:D":
Sub processNames()
Dim sh As Worksheet, lastR As Long, arr, i As Long
Set sh = ActiveSheet 'use here the sheet you need
lastR = sh.Range("B" & sh.rows.count).End(xlUp).row
arr = sh.Range("B2:B" & lastR).Value2
For i = 1 To UBound(arr)
arr(i, 1) = processNameMailAccount(CStr(arr(i, 1)))
Next i
'drop the processed array result in D:D:
sh.Range("D2").Resize(UBound(arr), 1).Value2 = arr
End Sub
If it returns as you need, you can change "D2" from the last code line in "B2" and the initial values in B:B will be replaced by the processed strings...
Related
I have two different excel sheets and trying to filter all the prices related to each fruit listed in sheet2.
Sheet1
Sheet2
As you can see, Orange price - 12 is not appearing in the sheet2.
Expected Result
LookupCSVResults function
Option Explicit
Function LookupCSVResults(lookupValue As Variant, lookupRange As Range, resultsRange As Range) As String
Dim s As String
Dim sTmp As String
Dim r As Long
Dim c As Long
Const strDelimiter = "|||"
s = strDelimiter
For r = 1 To lookupRange.Rows.Count
For c = 1 To lookupRange.Columns.Count
If lookupRange.Cells(r, c).Value = lookupValue Then
sTmp = resultsRange.Offset(r - 1, c - 1).Cells(1, 1).Value
If InStr(1, s, strDelimiter & sTmp & strDelimiter) = 0 Then
s = s & sTmp & strDelimiter
End If
End If
Next
Next
s = Replace(s, strDelimiter, ",")
If Left(s, 1) = "," Then s = Mid(s, 2)
If Right(s, 1) = "," Then s = Left(s, Len(s) - 1)
LookupCSVResults = s
End Function
Any suggestions would be appreciable.
Without seeing what the formula used on Sheet2 to get the list for Oranges, what I think that you have done is just copied down the formula from the cell above. This has the effect of moving the cells that the formula references down by one.
So I think that your formula for Orange is currently:
=LookupCSVResults(A2,Sheet1!B3:B10,Sheet1!C3:C10)
And is therefore not looking at the first row of data, which is for Orange.
Your formula should actually be:
=LookupCSVResults(A2,Sheet1!B2:B9,Sheet1!C2:C9)
which will return "12,8,9" as expected. A similar situation will probably occur for "Peach", but this is not being shown as an error.
You may want to used absolute cell positions:
=LookupCSVResults(Sheet2!A2,Sheet1!$B$2:$B$9,Sheet1!$C$2:$C$9)
Regards,
I am working on a program that needs to read an array of values from cells in another worksheet in the same workbook. I am able to read a single value just fine, but when I try to read multiple, I cannot return an array.
Here is what I am trying to do:
Dim list() As Variant
list = ActiveWorkbook.Worksheets("Sheet2").Range("A2:C2").value
Debug.Print TypeName(list)
Debug.Print UBound(list)
Debug.Print LBound(list)
Debug.Print TypeName(list(UBound(list)))
For which the output is:
Variant()
1
1
Subscript out of range
However, If I try it where I expect a single string, instead of an array of strings
Dim value As String
Let value = ActiveWorkbook.Worksheets("Site IDs and CJONs").Range("A2").value
Debug.Print TypeName(value)
Debug.Print value
for which I get the output
String
Expected Value
According to this question I should be able to simply return an array from the range function (example from the answer below), but it doesn't seem to be working for me. What am I doing wrong?
Dim DirArray As Variant
DirArray = Range("a1:a5").Value
Although it is not obvious, this:
Dim DirArray As Variant
DirArray = Range("a1:a5").Value
actually is like:
Dim DirArray(1 To 5, 1 To 1) As Variant
DirArray(1, 1) = Range("A1").Value
DirArray(2, 1) = Range("A2").Value
DirArray(3, 1) = Range("A3").Value
DirArray(4, 1) = Range("A4").Value
DirArray(5, 1) = Range("A5").Value
Pulling a set of cells into an array usually makes a 2-D array.
NOTE:
If you want to go from array to worksheet cells then, for example:
Sub ytrewq()
Dim DirArray(1 To 5, 1 To 1) As Variant
DirArray(1, 1) = "Larry"
DirArray(2, 1) = "Moe"
DirArray(3, 1) = "Curly"
DirArray(4, 1) = "Shepp"
DirArray(5, 1) = "James"
Range("B9").Resize(5, 1) = DirArray
End Sub
I might as well put my comment as an answer:
Option Explicit
Sub test()
Dim list As Variant
list = Application.Transpose(Application.Transpose(ActiveWorkbook.Worksheets("Sheet1").Range("A2:C2").Value))
Debug.Print TypeName(list)
Debug.Print UBound(list)
Debug.Print LBound(list)
'Debug.Print UBound(list, 2) Error
'Debug.Print LBound(list, 2) Error
Debug.Print TypeName(list(UBound(list)))
Debug.Print list(UBound(list))
End Sub
Gives output:
Variant()
3
1
String
x
where C2 contains letter x.
I have a userform whose image is below.
What i need is when i open the userform, there should be sequential number against voucher # textbox.
for example.
Column B has values BPV/1, BPV/2, BPV/3.
What i need is when i run the userform, the voucher # textbox should show the next serial number i.e. BPV/4 and so on...
Below is my code.
Private Sub UserForm_Initialize()
Dim NextNum As Long, prefix As String
Dim i As Long
prefix = "BPV/"
NextNum = Application.WorksheetFunction.Max(Worksheets("Sheet1").Columns(2))
i = NextNum + 1
Me.TextBox2.Enabled = False
Me.TextBox2.Value = prefix & i
End Sub
Kindly review the code and advise how to achieve it.
Thanks
Salman Khan
In order to find the Max value in Column B , that consists of Strings, I am reading the strings into an array on type Long (in case you have very large numbers), using the Mid function. Afterwards, I can find the Max value in the array of numbers.
Conveting using the Mid function is done with the following line:
myArr(lRow) = CLng(Mid(.Cells(lRow, 2), 5))
the value 5 is calculated by Len(prefix) +1
Code
Option Explicit
Private Sub UserForm_Initialize()
Dim NextNum As Long, prefix As String
Dim LastRow As Long, lRow As Long
Dim myArr() As Long
prefix = "BPV/"
With Sheets("Sheet1")
'find last row with data in Column B
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
ReDim myArr(2 To LastRow)
' read all cells contents and convert them to array of numbers
' start from 2nd row , 1st row has headers
For lRow = 2 To LastRow
If Mid(.Cells(lRow, 2), 5) <> "" Then
myArr(lRow) = CLng(Mid(.Cells(lRow, 2), 5))
End If
Next lRow
' find maximum value in array
NextNum = WorksheetFunction.Max(myArr)
End With
Me.TextBox2.Enabled = False
Me.TextBox2.Value = prefix & NextNum + 1
End Sub
You could enter this FormulaArray in Sheet1 let's say in A1:
=MAX(VALUE(SUBSTITUTE(B:B,"BPV/","")))
Then have this line pointing to that cell:
NextNum = Worksheets("Sheet1").Range("A1").value2
FormulaArrays are entered pressing* [Ctrl] + [Shift] + [Enter] simultaneously, you shall see { and } around the formula if entered correctly
This solutions uses the Application.Evaluate Method (Excel) to obtain the Last Voucher number at once avoiding the use of For...Next. It also uses constants (Const) to hold the Prefix and the MAX formula.
Private Sub UserForm_Initialize_EEM_Publish()
Const kPrefix As String = "BPV/"
Const kFml As String = "=MAX(IFERROR(1" & _
"*VALUE(SUBSTITUTE(#rTrg,""#Prefix"",""""))" & _
"*(SEARCH(""#Prefix"",#rTrg)),0))"
Dim rTrg As Range, sFml As String
Dim lNextNum As Long, l As Long
Rem Get Last Voucher Number
With ThisWorkbook.Worksheets("Sheet1").Columns("B")
Set rTrg = .Cells(1).Resize(.Cells(.Rows.Count).End(xlUp).Row)
End With
sFml = kFml
sFml = Replace(sFml, "#Prefix", kPrefix)
sFml = Replace(sFml, "#rTrg", rTrg.Address(, , , 1))
lNextNum = Application.Evaluate(sFml)
Rem Set Next Voucher Number
l = 1 + lNextNum
Me.TextBox2.Enabled = False
Me.TextBox2.Value = sPrefix & i
End Sub
I need to find all instances of particular identifier that may occur in one column and concatenate them into one string.
The identifier will start with "ECP" and be separated by a dash or space and have several characters after the separator. E.g. "ECP 05-00012A1, "ECP-123456."
I was using the formula below, but didn't think of multiple "ECP numbers."
=INDEX('Raw WAM Data'!$A$1:$A$10000,MATCH(VLOOKUP("*"&"ECP"&"*",'Raw WAM Data'!$A$1:$A$10000,1,FALSE),'Raw WAM Data'!$A$1:$A$10000,0))
I was then parsing the data in an adjacent cell using: =LEFT($C$62,FIND(" ", $C$62, FIND(" ", $C$62)+1))
This string was then loaded into a UserForm TextBox.
I would then need concatenate all the returned values into one string separated by commas so that it can load into the UserForm TextBox.
I would think that VBA would be ideal for this, but I am open to any suggestions.
If I've got correct understanding of what you trying to achive then you can use something like this:
Sub TEST()
Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
Dim cl As Range, x&
With Sheets("Sheet1") 'replace sheet1 by name of your sheet
x = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cl In .Range(.[A1], .Cells(x, "A"))
If UCase(cl.Value2) Like "ECP*" And Not dic.exists(cl.Value2) Then
dic.Add cl.Value2, Nothing
End If
Next cl
End With
Debug.Print Join(dic.keys, Chr(10))
End Sub
test
Updated
What's the best way to put the results in Column E relative to the cell in which it was found? Also, if I wanted to search multiple columns, how should I adapt the code?
you can use this way:
Sub TEST2()
Dim cl As Range, x&
With Sheets("Sheet1") 'replace sheet1 by name of your sheet
x = .[A:C].Find("*", , , , xlByRows, xlPrevious).Row 'get the last used row in range
For Each cl In .Range(.[A1], .Cells(x, "C"))
If UCase(cl.Value2) Like "*ECP*" Then
If .Cells(cl.Row, "E").Value2 = "" Then
.Cells(cl.Row, "E").Value2 = cl.Value2
Else
.Cells(cl.Row, "E").Value2 = .Cells(cl.Row, "E").Value2 & "; " & cl.Value2
End If
End If
Next cl
End With
End Sub
Output
If your values are in column A of a worksheet this routine will gather your ECP numbers and load them into an array. You can then load the array into your TextBox.
Sub GatherECPs()
Dim ECParr
'Loop down each row starting at row 2 (assuming you have headers)
For x = 2 To SourceSheet.Range("A2").End(xlDown).Row
'Check if the start of the string is ECP
If Left(SourceSheet.Cells(x, 1).Value, 3) = "ECP" Then
'Add a row to the array
If IsEmpty(ECParr) Then
ReDim ECParr(0)
Else
ReDim Preserve ECParr(UBound(ECParr) + 1)
End If
'Add the value to the array
ECParr(UBound(ECParr)) = Right(SourceSheet.Cells(x, 1).Value, Len(SourceSheet.Cells(x, 1).Value) - 4)
End If
Next
End Sub
Replace SourceSheet with the sheet where your values exist.
To do it in a fast way which also works for multiple "ECP" in one cell just use this function:
Public Function getStr(rng As Range, ident As String) As String
Dim i As Long, x As Variant, y As Variant
For Each x In Intersect(rng, rng.Parent.UsedRange).Value
y = Split(x, ident)
If UBound(y) > 0 Then
For i = 1 To UBound(y)
getStr = getStr & ", " & ident & Split(y(i), ",")(0)
Next
End If
Next
getStr = Mid(getStr, 3)
End Function
It will return a comma separated string. just use it like: getStr(Range("A:A"), "ECP")
If you still have any questions, just ask ;)
My sub compares two lists of strings and returns the closest matches. I've found that the sub gets tripped up over some common words such as "the" and "facility". I would like to write a function that would be supplied an array of words to exclude and check each string for these words and exclude them if found.
Here is a sample input:
|aNames | bNames | words to exclude
|thehillcrest |oceanview health| the
|oceanview, the|hillCrest | health
Intended Output:
|aResults |bResuts
|hillcrest |hillcrest
|oceanview |oceanview
So far I have:
Dim ub as Integer
Dim excludeWords() As String
'First grab the words to be excluded
If sheet.Cells(2, 7).Value <> "" Then
For y = 2 To sheet.Range("G:G").End(xlDown).Row
ub = UBound(excludeWords) + 1 'I'm getting a subscript out of range error here..?
ReDim Preserve excludeWords(0 To ub)
excludeWords(ub) = sheet.Cells(y, 7).Value
Next y
End If
Then my comparison function, using a double loop, will compare each string in column A with column B. Before the comparison, the value in column a and b will go through our function which will check for these words to exclude. It's possible that there will be no words to exclude, so the parameter should be optional:
Public Function normalizeString(s As String, ParamArray a() As Variant)
if a(0) then 'How can I check?
for i = 0 to UBound(a)
s = Replace(s, a(i))
next i
end if
normalizeString = Trim(LCase(s))
End Function
There's probably a few parts in this code that won't work. Might you be able to point me in the right direction?
Thank you!
To store the list in the array, you can do this
Sub Sample()
Dim excludeWords As Variant
Dim lRow As Long
With Sheet1 '<~~ Change this to the relevant sheet
'~~> Get last row in Col G
lRow = .Range("G" & .Rows.Count).End(xlUp).Row
excludeWords = .Range("G2:G" & lRow).Value
'Debug.Print UBound(excludeWords)
'For i = LBound(excludeWords) To UBound(excludeWords)
'Debug.Print excludeWords(i, 1)
'Next i
End With
End Sub
And then pass the array to your function. The above array is a 2D array and hence needs to be handled accordingly (see commented section in the code above)
Also like I mentioned in the comments above
How does oceanview, the become Oceanview? You can replace the but that would give you oceanview, (notice the comma) and not Oceanview.
You may have to pass those special characters to Col G in the sheet or you can handle them in your function using a loop. For that you will have to use the ASCII characters. Please see this
Followup from comments
Here is something that I wrote quickly so it is not extensively tested. Is this what you are looking for?
Sub Sample()
Dim excludeWords As Variant
Dim lRow As Long
With Sheet1
lRow = .Range("G" & .Rows.Count).End(xlUp).Row
excludeWords = .Range("G2:G" & lRow).Value
'~~> My column G has the word "habilitation" and "this"
Debug.Print normalizeString("This is rehabilitation", excludeWords)
'~~> Output is "is rehabilitation"
End With
End Sub
Public Function normalizeString(s As String, a As Variant) As String
Dim i As Long, j As Long
Dim tmpAr As Variant
If InStr(1, s, " ") Then
tmpAr = Split(s, " ")
For i = LBound(a) To UBound(a)
For j = LBound(tmpAr) To UBound(tmpAr)
If LCase(Trim(tmpAr(j))) = LCase(Trim(a(i, 1))) Then tmpAr(j) = ""
Next j
Next i
s = Join(tmpAr, " ")
Else
For i = LBound(a) To UBound(a)
If LCase(Trim(s)) = LCase(Trim(a(i, 1))) Then
s = ""
Exit For
End If
Next i
End If
normalizeString = Trim(LCase(s))
End Function
First of all, you cannot call UBound function for the Array that doesn't have a size yet:
Dim excludeWords() As String
ub = UBound(excludeWords) + 1 'there is no size yet
To remove some of the unwanted words use Replace function
String1 = Replace(String1, "the", "")
To do the comparison you described I would use Like function. Here is documentation.
http://msdn.microsoft.com/pl-pl/library/swf8kaxw.aspx