I'm using the code below to separate a group of strings separated by a comma (,), then saves the output in a string variable named, msg. Strings in variable msg is separated by vbNewLine.
For example:
Original string for example is fruits, contains: apple, mango, orange
after applying the function splittext(fruits)
the variable now msg contains: apple <vbNewLine> mango <vbNewLine> orange
Now, I wanted to separate the content of this msg to cell(each string).
For example, mango is in A1, apple is in A2, orange is in A3 (on a different sheet.
I tried 'ActiveWorkbooks.Sheets("Sheet2").Range("A" & i).Value = Cs(i), (see the code below). But it's not working. After the execution, the cells in the sheet2 remains unchanged. I really need your help. Thanks.
Function splittext(input_string As String) As String
Dim SptTxt As String
Dim Cs As Variant
Dim CsL As Byte
Dim CsU As Byte
Dim i As Byte
Dim col As Collection
Set col = New Collection
Cs = Split(input_string, ",")
CsL = LBound(Cs)
CsU = UBound(Cs)
Dim msg As String
For i = CsL To CsU
ReDim arr(1 To CsU)
col.Add Cs(i)
msg = msg & Cs(i) & vbNewLine
'ActiveWorkbooks.Sheets("Sheet2").Range("A" & i).Value = Cs(i)
Next
splittext = msg
End Function
Here's your macro refactored to give the results you describe, without any looping.
Function splittext(input_string As String) As String
Dim Cs As Variant
Cs = Split(input_string, ",")
splittext = Join(Cs, vbNewLine)
' Put results into workbook
With ActiveWorkbook.Sheets("Sheet2")
Range(.[A1], .Cells(UBound(Cs) + 1, 1)).Value = Application.Transpose(Cs)
End With
End Function
Note that copying an array to a range requires a 2 dimensional array, rows x columns. Transpose is a handy function to convert a 1 dim array to a 2 dim array
EDIT
Note that if you call this as a user-defined function (UDF) from a cell (as you are in the sample file) it will fail (If it is called from a VBA Sub it will work). This is because a UDF cannot modify anything in Excel, it can only return to the calling cell (there is a rather complex workaround, see this answer.) If you remove the With section it does work as a UDF.
If what you are trying to return the list into multiple cells, consider using an array function.
You have to use it like that:
ActiveWorkbook.Sheets("Sheet2").Range("A" & i+1).Value = Cs(i)
You try to write in the Cell "A0" because "i" is in the First loop zero. And this is not working because there is no cell "A0".
And you had an "s" by ActiveWorkbook.
Moosli
Related
I would like to convert a range of numbers (and single digits) from a number-only format to alpha-numeric format. Entire statement is in a single, excel cell and would like the converted version to be in a neighboring cell.
As an example:
Assuming 1-24=B1-B24
Assuming 25-48=C1-C24
INPUT—
screen 1-3,5,7-9,11-30,32-37,39-40,41,44-46
DESIRED OUTPUT (all acceptable)
screen B1-B3,B5,B7-B9,B11-C6,C8-C13,C15-C16,C17,C20-C22
OR
screen B1-B3,B5,B7-B9,B11-B24,C1-C6,C8-C13,C15-C16,C17,C20-C22
OR
screen B1-B3,B5,B7-B9,B11-B24
screen C1-C6,C8-C13,C15-C16,C17,C20-C22
Using excel functions is proving quite cumbersome so excel macro would be better. I've looked for examples of requested conversion but haven't found anything.
Any help is greatly appreciated.
Cheers,
Bob
Hey here is a solution that i tested out. Not sure if "screen" needs to be in the string or not. Let me know and I will tweak it if that's the case.
Its a user defined function. So drop this vba in a module and then go to a worksheet and type in "=AlphaConvert(" + the cell reference.
Assumption here is that only one cell will be referenced at a time.
Last this could easily be converted to a sub routine and probably run a bit faster than the function.
Public Function AlphaConvert(TargetCell As Range)
Dim v As Long
Dim vArr() As String
Dim i As Long
Dim iArr() As String
Dim a As String
vArr = Split(TargetCell.Value, ",")
For v = LBound(vArr) To UBound(vArr)
If InStr(vArr(v), "-") > 0 Then
iArr = Split(vArr(v), "-")
For i = LBound(iArr) To UBound(iArr)
If i = LBound(iArr) Then
a = AlphaCode(iArr(i))
Else
a = a & "-" & AlphaCode(iArr(i))
End If
Next i
vArr(v) = a
Else
vArr(v) = AlphaCode(vArr(v))
End If
If v = LBound(vArr) Then
AlphaConvert = vArr(v)
Else
AlphaConvert = AlphaConvert & "," & vArr(v)
End If
Next v
End Function
Private Function AlphaCode(Nbr As Variant)
Select Case Nbr
Case 1 To 24
AlphaCode = "B" & Nbr
Case Else
AlphaCode = "C" & Nbr - 24
End Select
End Function
I have a large list of points with PNEZD (point, northing, easting, elevation, description) fallowed by a few attributes for each point. how can I combine these extra attribute columns to my D column separated by a space? And can i do that with a push of a button?
example of a few points would be
10,1000,5000,50,tree,birch,12IN
11,1100,5500,55,tree,spruce,10IN
12,1130,5560,54,powerpole,tele,wood,12IN,guyed
I want to combine the last few so it will read:
10,1000,5000,50,tree birch 12IN
11,1100,5500,55,tree spruce 10IN
12,1130,5560,54,powerpole tele wood 12IN guyed
please help!
You can create a user-defined function in VBA that you can then use on your worksheet as any normal formula.
From Excel, press Alt+F11 to get to the VBA editor. Once there, press Ctrl+R to show or activate the Project Explorer. Right-click on the Modules node, and select Insert -> Module. Put the code below into the module:
Option Explicit
Public Function GetPnezdLabel(pnezd As Variant) As Variant
On Error GoTo errHandler
Dim result As Variant
Dim parts As Variant
Dim lastPartIndex As Long
Dim intermediatePartIndex As Long
Dim index As Long
result = ""
parts = Split(CStr(pnezd), ",", Compare:=VbCompareMethod.vbBinaryCompare)
lastPartIndex = UBound(parts)
intermediatePartIndex = Application.WorksheetFunction.Min(3, lastPartIndex)
For index = 0 To intermediatePartIndex
result = result & parts(index) & IIf(index < lastPartIndex, ",", "")
Next
For index = 4 To lastPartIndex
result = result & parts(index) & IIf(index < lastPartIndex, " ", "")
Next
Done:
GetPnezdLabel = result
Exit Function
errHandler:
result = XlCVError.xlErrValue
Resume Done
End Function
Press Alt+F11 to return to Excel. Now, assuming you have a PNEZD value in cell A1, you can create a formula in e.g. B1 as follows:
=GetPnezdLabel(A1)
and you'll see the result appear.
The principle behind the GetPnezdLabel function is to split the parameter's value at commas and to build the result from the parts.
For information, the same result can be achieved through following formula.
Assuming your data is in cell A2 then in cell D2 insert following formula and copy down.
=TRIM(LEFT(SUBSTITUTE(A2,",",REPT(" ",199),4),199))
&","&
SUBSTITUTE(TRIM(RIGHT(SUBSTITUTE(A2,",",REPT(" ",199),4),199)),","," ")
As you've indicated VBA specifically, you may not want a formula solution.
I have the following data set, which contains duplicates.
values:
2880CR-20.36KX53305DECOAK2015
F05572-CN48517OCTOAK2016
F05572-CN48517DECOAK2016
F05572-CN48517NOVOAK2015
F05572-CN48517NOVOAK2015(duplicate)
F05572-CN48517DECOAK2015
F05573-CN48517JANOAK2016
F05573-CN48517FEBOAK2016
F05573-CN48517JANOAK2015
F05573-CN48517FEBOAK2015
F05573-CN48517MAROAK2015
F05573-CN48517APROAK2015
F05573-CN48517APROAK2015(duplicate)
I am trying to create a macro that will look at the values in column A, from A2:A (count of rows in column), and return a list of the duplicate values contained in the string declared "strMyDupList". Basically, if there is atleast 1 duplicate, the msgbox will pop up and the new sheet created with the columns address and values and I am trying to list out all the values seperated my a comma VERTICALLY, instead of horizontally across the sheet. so like:
Address value
$A$5 F05572-CN48517NOVOAK2015
$A$13 F05573-CN48517APROAK2015
my code is :
If strMyDupList <> "" Then
MsgBox "The following entries have been used more than once:" & vbNewLine & strMyDupList
Worksheets.Add.name = name
Worksheets(name).Range("A1").Value = "Location"
Worksheets(name).Range("B1").Value = "Value"
' Worksheets(name).Range("A2:C2").Value = Split(strMyDupList, ",")
Worksheets(name).Range("B4:B6") = Split(Application.WorksheetFunction.Transpose(strMyDupList), ",")
The results are that I am able to get the values tranposed from horizontal to vertical, however, with this code, it is only returning the FIRST VALUE in the list of values in the string, so it's returning:
Address value
$A$5 F05572-CN48517NOVOAK2015
$A$5 F05572-CN48517NOVOAK2015 (should be F05573-CN48517APROAK2015)
I've seen the UBound with Resize could work but I have no idea how the syntax works or is used. Can someone assist?
Thank you
Here is a complete example of how to leave duplicates out of your information.
Essentially, it sorts all of your information. Therefore, when you sort you'll get the consecutive value which would be itself if it was a dupe.
It uses a .NET feature, System.Collections.ArrayList, that was in 2.0 & 3.5 so that has to be installed on your machine. Usually it already is but it may not be. You can turn it on through Programs & Features.
Sub StringArrayDupeChecker()
Dim var As Variant
Dim holder As String
Dim strMyList() As String
Dim myDupeData As Variant
Dim str As String
str = "one,two,three,three,three,four,five,five"
strMyList = Split(str, ",")
holder = ""
Set var = CreateObject("System.Collections.ArrayList")
Set myDupeData = CreateObject("System.Collections.ArrayList")
For Each i In strMyList
var.Add (i)
Next i
var.Sort
For Each j In var
If Not j = holder Then
'do your stuff
str = "notDupe"
Else
myDupeData.Add(j)
End If
holder = j
Next j
End Sub
I have a worksheet that contains information on projects. The worksheet contains a column which contains risks for each project. There is a one-to-many relationship between a project and its risks.
Currently the risks for a projects are added to single cell and separated by a line break. I need to add sequential identifiers at the start of each risk. So for example inside a particular cell it should look like this. The sequential number should be bold if at all possible.
1).**Risk 1
2).**Risk 2
3).**Risk 3
etc.
Any suggestions on how to tackle this would be appreciated.
Here's how I'd approach it via UDF:
' Reformats a list from a simple delimitation to a numbered list
' Accepts arrays of strings for inList (allowing array formulas)
' numFormat is a standard Excel-style format string (default "0. ")
' inDelimiter is the delimiter in the input list
' outDelimiter is the delimiter for the output list
Public Function TO_NUMBERED_LIST(inList As Variant, Optional numFormat As Variant, _
Optional inDelimiter As Variant, Optional outDelimiter As Variant) As Variant
Dim i As Integer, j As Integer
' Set default parameters
If IsMissing(numFormat) Then numFormat = "0). "
If IsMissing(inDelimiter) Then inDelimiter = vbNewLine
If IsMissing(outDelimiter) Then outDelimiter = inDelimiter
If IsArray(inList) Then ' Must loop through each entry if using as an array formula
Dim outList() As Variant
ReDim outList(0 To (UBound(inList) - LBound(inList)), 1 To 1)
j = 0
For i = LBound(inList) To UBound(inList)
If IsError(inList(i, 1)) Then
outList(j, 1) = inList(i, 1)
Else
outList(j, 1) = MakeNumbered(CStr(inList(i, 1)), CStr(numFormat), CStr(inDelimiter), CStr(outDelimiter))
End If
j = j + 1
Next
TO_NUMBERED_LIST = outList
Else
TO_NUMBERED_LIST = MakeNumbered(CStr(inList), CStr(numFormat), CStr(inDelimiter), CStr(outDelimiter))
End If
End Function
' Helper function to do the actual work of splitting lists, numbering them, and recombining them
Private Function MakeNumbered(inList As String, Optional numFormat As String, _
Optional inDelimiter As String, Optional outDelimiter As String) As String
Dim i As Integer
Dim tokenArr() As String
tokenArr = Split(inList, inDelimiter)
For i = 0 To UBound(tokenArr)
tokenArr(i) = Format(i + 1, numFormat) & tokenArr(i)
Next
MakeNumbered = Join(tokenArr, outDelimiter)
End Function
I leverage some knowledge from your previous thread, like the fact that the input might be an array (and the whole function might be used in an array formula) but will only ever be 1-dimensional.
I've made this pretty general for reformatting. It can take in lists with any input delimiter (in your case, a newline) and output using any desired delimiter (in your case, still a newline). The numFormat parameter acts using the Format function and supports formats like you would commonly see in Excel. Check the documentation if you need help there.
Default parameters have already been tweaked for your example - newline as delimiter(s) and "0). " as numbering format.
You can use the Split function on each cell value to create an array of risks and then prefix each risk with the sequence id. Then you can use the Join function to put the array back into a single value to update the cell with.
Depending on how the newlines got into the cell you might need to use vbCrLf, or vbNewLine instead of vbLf in the following example code:
Option Explicit
Sub AddRiskSequence()
Dim rngRisks As Range
Dim rngCell As Range
Dim varRisks As Variant
Dim lngIndex As Long
'set range with risk values
Set rngRisks = Sheet2.Range("B2:B4")
'iterate cells in risk column
For Each rngCell In rngRisks
'split cell contents by line feed into array
varRisks = VBA.Split(rngCell.Value, vbLf)
'iterate array and add sequence ids
For lngIndex = 0 To UBound(varRisks)
varRisks(lngIndex) = VBA.CStr(lngIndex + 1) & ") " & varRisks(lngIndex)
Next lngIndex
'rejoin array and update cell value
rngCell.Value = VBA.Join(varRisks, vbLf)
Next rngCell
End Sub
Before:
After:
I want to count all Commas "," that occur only in selected text after that I will use Count as Integer to run the loop
My question is how do i Count , as following Image shows:
I Don't know how to use split and ubound. what is wrong with following code?
Sub CountComma()
Dim x As String, count As Integer, myRange As Range
Set myRange = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End)
x = Split(myRange, ",")
count = UBound(x)
Debug.Print count
End Sub
A simple split will work.
x = Split("XXX,XXX,XXX,XXX,XX,XX", ",")
Count = UBound(x)
Debug.Print Count
B/c the array starts at zero you can take to Ubound number as is.
EDIT:
To use a range .
x = Split(Range("A1").Value, ",")
To break down the code.
Split("A string value","Delimiter to split the string by")
And if you want a single line of code than,
x = UBound(Split(myRange, ","))
your code is wrong in the initial declaration statement of x variable as of string type , since in the subsequent statement
with x = Split(myRange, ",")
you'd want x hold the return value of Split() function which is an array (see here), thus of Variant type
so you have to use
Dim x As Variant
But you can simplify your code as follows
Option Explicit
Sub CountComma()
Dim count As Integer
count = UBound(Split(Selection, ","))
Debug.Print count
End Sub
since:
you don't need any Range type variable to store Selection object into, being Selection the selected range already (see here)
you don't need the x Variant variable neither, feeding UBound()function (which expects an array as its first argument) directly with the Split() function which, as we saw above, returns just an array!
Finally I'd give out an alternative method of counting commas in a range
Sub CountComma()
Dim countAs Integer
count = Len(Selection) - Len(Replace(Selection, ",", ""))
Debug.Print count
End Sub
Thanks to KyloRen and Cindy Meister, Now I can use split and Ubound for Counting , in selection.text.
Following is working Code:
Sub Count_Words()
Dim WrdArray() As String, myRange As String
myRange = ActiveDocument.Range(Selection.Range.Start, Selection.Range.End)
WrdArray() = Split(myRange, ", ")
MsgBox ("Total , in the string : " & UBound(WrdArray()))
End Sub