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.
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
Im trying to evaluate Formula array to find a value from sheet with multiple criteria. The sheet name is Holiday_master
So in another sheet Temp_data I tried to exceute the following code to set that value in that cell using formula array
Public Function getCostMultiplier(dt As Date, wt As String) As Double 'dt is the date of entry, wt working time name "India Full Time","Singapore f........
Dim lRow As Integer
Dim we As Boolean
we = IsWeekend(dt)
Dim nhRange As Range
Dim d As Double
d = CDbl(dt)
Dim location As String
Select Case LCase(Trim(wt))
Case "india full time 45"
location = "INDIA"
Case "singapore full time 40"
location = "SINGAPORE"
Case "uk full time 40"
location = "UK"
End Select
Dim n As Integer
'n = Application.Evaluate()
lRow = Sheets("Holiday_master").Range("A1000").End(xlUp).Row + 1
Dim formula As String
Dim s As String
s = Application.Evaluate("RC11")
formula = printf("{=INDEX( Holiday_master!R2C3:R{0}C3,MATCH(1,(""{1}""=Holiday_master!R2C2:R{0}C2)*({2}=Holiday_master!R2C1:R{0}C1),0),1)}", lRow, location, d)
''''INDEX( Holiday_master!R2C3:R11C3,MATCH(1,("INDIA"=Holiday_master!R2C2:R11C2)*(43126=Holiday_master!R2C1:R11C1),0),1)
n = Application.Evaluate(formula)
getCostMultiplier = n
End Function
Public Function printf(mask As String, ParamArray tokens()) As String
Dim i As Long
For i = 0 To UBound(tokens)
mask = Replace$(mask, "{" & i & "}", tokens(i))
Next
printf = mask
End Function
So in Temp_data sheet in a cell I set the formula as getCostMultiplier(RC11,RC4)', so obviously it reaches my function with parameters26-01-2018andINDIA`
So in the code we have a final formula which is I commented there INDEX( Holiday_master!R2C3:R11C3,MATCH(1,("INDIA"=Holiday_master!R2C2:R11C2)*(43101=Holiday_master!R2C1:R11C1),0),1)
But its not evaluating as I expected or this could not be the way for evaluation of formula array.
If I execute that formula in that cell manually and on submitting (ctrl+shift+enter) it executes properly and returning the value.
So I didnt understand how to do that same from VBA or how to do that Evaluation. I never used Evaluation before
Convert the formula from xlR1C1 to xlA1 syntax.
n = Application.Evaluate(Application.ConvertFormula(formula, xlR1C1, xlA1))
Using Evaluate within VBA should be done with xlA1 syntax.
I got it working with R1C1 itself. The issue was, I specified curly braces there in the formula array which is not required in the case of Evaluate
So here is my modified formula code with error validation also added
formula = printf("=IFERROR(INDEX(Holiday_master!R2C3:R{0}C3,MATCH(1,(""{1}""=Holiday_master!R2C2:R{0}C2)*({2}=Holiday_master!R2C1:R{0}C1),0),1),1)", lRow, location, CStr(d))
I have a column full of data with multiple lines inside a single cell like below:
I am looping through all the cells in the column and I have to select values inside every cell and search it in another sheet.I know i can split the cell value using the Split() function in vba.
But where I am struck is I am unable to select the whole value of the cell and parse it as input to the split () function. Here is my sample code where i am struck:
For Each C in Range ("A1:A" & ltrow)
If C.Value <> "" Then
SrcStrng = C.Value
TextArray () = Split(SrcStrng)
.....
........
.....
The problem I face here is in SrcStrng only the first value inside the cell for example in the first cell only t#234 is getting stored, so in split string only that is passed and it is not split properly, so I am unable to search t*567. It happens for every cell.
And also in the third cell, i want to parse only the value t#345 inside the loop for searching, neglecting L1:, I am struck with that too.
Could someone help me with this please.
Here is an example to show how this can be done. Use chr(10) as delimiter
Sub t()
Dim str As String
str = Range("A1").Value
Dim parts As Variant
parts = Split(str, Chr(10))
For i = LBound(parts) To UBound(parts)
MsgBox (parts(i))
Next i
End Sub
I have been trying to create a function to retrieve column titles found in row four in an excel sheet. This is what I have so far, can anybody help me please?
Sub Test_Click()
Dim text As String
Dim titles(200) As String
Dim nTitles As Integer
For i = 1 To 199
If Trim(Sheets("Sheet1").Cells(4, i).Value) = "" Then
nTitles = i - 1
Exit For
End If
titles(i - 1) = Sheets("Sheet1").Cells(4, i).Value
Next
For i = 0 To nTitles
Sheets("Sheet1").Cells(20 + i, 1).Value = titles(i)
Next
End Sub
You need to make an array function for this. So your function will take in inputs through a range
Function ReturnArray(Input as Range) as Variant
' Do stuff with the Input range
Dim Output(m,n) as Variant
'Loop through m,n to fill in the output values as you would in a range
ReturnArray = Output
End Function
And when you put in the function in excel, type it in the cell after highlighting where you want the output and press Ctrl-Shift-Return
Just as you write a Sub you can write a Function, just substitute the words at the beginning and at the end of your code.
Now, about how to return the values, obviously it will be an array, so you'll need to declare the array, set its size, fill its cells and return it. This can be done like this:
Function yourFunction() as String()
' You already have an array named "titles" which stores the values you want
' to return. Fill it exactly as you do in your original code.
yourFunction = titles ' This is the way to return the array.
End Function
If you want to use this function in a worksheet (as a formula), remember that this is an array-function, so you'll need to press Ctrl+Shitf+Enter after you enter the function in the cell instead of just [Enter].
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