I've been trying to find/write a macro that opens all hyperlinks contained in a selected range at once. The code I've come across works on only some types of hyperlinks, specifically hyperlinks added through either the right click/Insert>Link/Ctrl+K. The code wont recognise any hyperlinks that are formed using the HYPERLINK() function.
Here's the code I found online:
Sub OpenMultipleLinks()
On Error Resume Next
Set myRange = Application.Selection
Set myRange = Application.InputBox("Range", "OpenMultipleLinks", myRange.Address, Type:=8)
For Each oneLink In myRange.Hyperlinks
oneLink.Follow
Next
End Sub
And here's the formula of a cell that becomes a hyperlink.
=IF($D2="All Charts","",HYPERLINK("http://SubstituteWebsite/ChartId="&$D2&$AF$1,"link"))
Since you do not answer my clarification questions, I will assume that my understanding is correct. So, the following code will work if your formulae containing 'HYPERLINK' formula inside respect the pattern you show us and it should be followed without evaluating if the formula condition is True:
Sub OpenMultipleLinks()
Dim myrange As Range, cel As Range, oneLink
On Error Resume Next
Set myrange = Application.Selection
Set myrange = Application.InputBox("Range", "OpenMultipleLinks", myrange.Address, Type:=8)
For Each oneLink In myrange.Hyperlinks
oneLink.Follow
Next
On Error GoTo 0
For Each cel In myrange
If InStr(cel.Formula, "HYPERLINK") > 0 Then
ActiveWorkbook.FollowHyperlink extractHypFromFormula(ActiveCell.Formula)
End If
Next
End Sub
Function extractHypFromFormula(strForm As String) As String
Dim Hpos As Long, startP As Long, Hlength As Long, strRoot As String
Dim startP2 As Long, cellsAddr As String
Hpos = InStr(strForm, "HYPERLINK") 'it returns position of the first character for "HYPERLINK" string in the formula
If Hpos > 0 Then
startP = Hpos + Len("HYPERLINK") + 2 'it builds the position after which to start searching
'+ 2 because of '(' and "
Hlength = InStr(startP, strForm, """") - startP 'length of the hyperlink fix part (before the strings taken from the two cells value)
strRoot = Mid(strForm, startP, Hlength) 'it returns the hyperlink fix part
startP2 = startP + Len(strRoot) + 2 'next START to return the string keeping the concatenation of the two cells value
cellsAddr = Mid(strForm, startP2, InStr(startP2, strForm, ",") - startP2) 'the string keeping the concatenation of the two cells value
'split the string on "&" separator and use the two elements as range string:
extractHypFromFormula = strRoot & Range(Split(cellsAddr, "&")(0)).value & Range(Split(cellsAddr, "&")(1)).value
End If
End Function
Please, send some feedback after testing it...
You need to parse/evaluate the "hyperlink" formula first. Assuming all your links are in col A this will do what you want:
Sub link()
Dim arr, arr2, j As Long
arr = Sheet1.Range("A1").CurrentRegion.Formula2 'get all in an array
For j = 1 To UBound(arr)
If Left(arr(j, 1), 3) = "=HY" Then 'check if it's a formula
arr(j, 1) = Evaluate(Split(Mid(arr(j, 1), 2), ",")(0) & ")") 'split the url from the rest, evaluate and replace in array
End If
ActiveWorkbook.FollowHyperlink Address:=arr(j, 1), NewWindow:=True 'open in default browser
Next j
End Sub
Best of luck,
ceci
Related
I am not too experienced in VBA but found a code online that creates combinations in an excel sheet. This is great except, I need a rule in there that it should skip cells in the combination generator when empty. I tried a couple setups but it kept giving me the same result over and over.
So if i have the following table:
Table 1
Table 2
1
a
b
3
c
The outcome should result in:
1-a
1-b
1-c
3-a
3-b
3-c
However, it leads to:
1-a
1-b
1-c
-a
-b
-c
3-a
3-b
3-c
Anyone can give me a tip or idea to see if this can be solved? Would love to know what is possible before investing too much time in it. Find the VBA below. Thanks in advance!
Sub CombinationGenerator()
Dim xDRg1, xDRg2, xDRg3 As Range
Dim xRg As Range
Dim xStr As String
Dim xFN1, xFN2, xFN3 As Integer
Dim xSV1, xSV2, xSV3 As String
Set xDRg1 = Range("A2:A6") 'First column data
Set xDRg2 = Range("B2:B2") 'Second column data
Set xDRg3 = Range("C2:C2") 'Third column data
xStr = "-" 'Separator
Set xRg = Range("E2") 'Output cell
'Creating combinations
For xFN1 = 1 To xDRg1.Count
If Cells(xFN1, "A") <> "" Then 'Ignore empty cells
xSV1 = xDRg1.Item(xFN1).Text
For xFN2 = 1 To xDRg2.Count
xSV2 = xDRg2.Item(xFN2).Text
For xFN3 = 1 To xDRg3.Count
xSV3 = xDRg3.Item(xFN3).Text
xRg.Value = xSV1 & xStr & xSV2 & xStr & xSV3
Set xRg = xRg.Offset(1, 0)
Next
Next
End If
Next
End Sub
xFN1 iterates from 1 to xDRg1.Cells.Count but the first row of xDRg1 is 2. So when you rebuild the range during the line Cells(xFN1, "A") you're putting 1, 2, 3 instead of 2, 3, 4 for the row numbers.
To avoid confusing code like this, I would suggest switching the For loop to a For Each loop using the Range.Cells collection, meaning the loop element would be a Cell (Range Object) instead of a Row number.
Sub CombinationGenerator()
Dim xDRg1 As Range, xDRg2 As Range, xDRg3 As Range
Dim xRg As Range
Dim xStr As String
Dim xFN1 As Range, xFN2 As Range, xFN3 As Range
Dim xSV1 As String, xSV2 As String, xSV3 As String
Set xDRg1 = Range("A2:A6") 'First column data
Set xDRg2 = Range("B2:B2") 'Second column data
Set xDRg3 = Range("C2:C2") 'Third column data
xStr = "-" 'Separator
Set xRg = Range("E2") 'Output cell
'Creating combinations
For Each xFN1 In xDRg1.Cells
If xFN1 <> "" Then 'Ignore empty cells
xSV1 = xFN1.Text
For Each xFN2 In xDRg2.Cells
xSV2 = xFN2.Text
For Each xFN3 In xDRg3.Cells
xSV3 = xFN3.Text
xRg.Value = xSV1 & xStr & xSV2 & xStr & xSV3
Set xRg = xRg.Offset(1, 0)
Next
Next
End If
Next
End Sub
Alright, this is a very specific question. I have an excel macro written that takes a web URL, delimits it, transposes it, and then adds adjacent columns that describe the information in the originally transposed columns. Now, I need to add something to my macro that will loop through and check if the first character of one cell matches one of the first 4 characters of another cell. If it does, I need to concatenate strings from the descriptive columns to new cells. I'll illustrate this below:
3,435,201,0.5,%22type%25202%2520diabetes%22,0 Node type 2 diabetes
4,165,97,0.5,%22diet%22,0 Node diet
5,149,248,0.5,%22lack%2520of%2520exercise%22,2 Node lack of exercise
6,289,329,0.5,%22genetics%22,3 Node genetics
7,300,71,0.5,%22blood%2520pressure%2520%22,5 Node blood pressure
7,3,-7,1,0 Arrow +
4,3,-21,1,0 Arrow +
5,3,-22,1,0 Arrow +
6,3,-34,1,0 Arrow +
,7%5D Tail
I added color to make the concept of the problem more easily visualized. In row one of the first column, we see a red 3 that corresponds to 'type 2 diabetes'. In the fifth row of the first column, we see a blue 7 that corresponds to 'blood pressure'. These are both node objects, as the adjacent column signifies. In the sixth cell of the first column we see a blue 7 and a red 3. This indicates that an arrow (also signified by adjacent column) is connecting blood pressure to diabetes. In the next column over, we see an orange plus sign, which indicates this is a positive relationship.
The goal is to populate the next column over with "blood pressure + type diabetes", as I demonstrated in the image. So, I need some code to check the first characters in each node cell, and then compare them to the first 4 characters of each arrow cell. When an arrow that matches two of the nodes is found, I need the code to populate the row next to the + signs with a concatenated string comprised of the names of the nodes pertaining to that arrow, as well as the + sign between them (it's possible that it could also be a minus sign, but one isn't present in this example). Any pointers? I can't wrap my head around this. Edited to add Data
Here is the code of my current macro:
Sub Delimit_Transpose()
Cells.Replace What:="],[", Replacement:="#", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveCell.FormulaR1C1 = "=RIGHT(R[-1]C,LEN(R[-1]C)-36)"
Dim i As Long, strTxt As String
Dim startP As Range
Dim xRg As Range, yRg As Range
On Error Resume Next
Set xRg = Application.InputBox _
(Prompt:="Range Selection...", _
Title:="Delimit Transpose", Type:=8)
i = 1
Application.ScreenUpdating = False
For Each yRg In xRg
If i = 1 Then
strTxt = yRg.Text
i = 2
Else
strTxt = strTxt & "," & yRg.Text
End If
Next
Application.ScreenUpdating = True
Set startP = Application.InputBox _
(Prompt:="Paste Range...", _
Title:="Delimit Transpose", Type:=8)
ary = Split(strTxt, "#")
i = 1
Application.ScreenUpdating = False
For Each a In ary
startP(i, 1).Value = Replace(Replace(a, "[", ""), "]", "")
i = i + 1
Next a
i = 1
For Each a In ary
If Len(a) > 13 Then
startP.Offset(i - 1, 1).Value = "Node"
ElseIf Len(a) < 13 And Len(a) > 6 Then
startP.Offset(i - 1, 1).Value = "Arrow"
Else
startP.Offset(i - 1, 1).Value = "Tail"
End If
i = i + 1
Next a
Dim openPos As Integer
Dim closePos As Integer
Dim midBit As String
i = 1
n = 5
For Each a In ary
openPos = InStr(a, ",%22")
On Error Resume Next
closePos = InStr(a, "%22,")
On Error Resume Next
midBit = Mid(a, openPos + 1, closePos - openPos - 1)
On Error Resume Next
If openPos <> 0 And Len(midBit) > 0 Then
startP.Offset(i - 1, 2).Value = Replace(Replace(midBit, "%22", ""), "%2520", " ")
ElseIf Len(a) < 13 And InStr(a, "-") = 4 Then
startP.Offset(i - 1, 2).Value = "'-"
ElseIf Len(a) < 7 Then
startP.Offset(i - 1, 2).Value = " "
Else
startP.Offset(i - 1, 2).Value = "+"
End If
i = i + 1
n = n + 1
Next a
Application.ScreenUpdating = True
End Sub
This is my approach.
There's room for a lot of improvements, but is a rough code that should get you started.
Read the code's comments and adapt it to fit your needs.
EDIT: I updated the code to match the sample worksheet you uploaded, build the first column range dinamically, validate if commas appear in the first column cell so no error is raised.
As I said in the comments, it's better easier to debug if you call one procedure from the other, instead of merging them.
Code:
Option Explicit
Public Sub StoreConcatenate()
' Basic error handling
On Error GoTo CleanFail
' Define general parameters
Dim targetSheetName As String
targetSheetName = "Test space" ' Sheet holding the data
Dim firstColumnLetter As String
firstColumnLetter = "C" ' First column holding the numbers
Dim firstColumnStartRow As Long
firstColumnStartRow = 7
' With these three parameters we'll build the range address holding the first column dynamically
' Set reference to worksheet
Dim targetSheet As Worksheet
Set targetSheet = ThisWorkbook.Worksheets(targetSheetName)
' Find last row in column (Modify on what column)
Dim firstColumnlastRow As Long
firstColumnlastRow = targetSheet.Cells(targetSheet.Rows.Count, firstColumnLetter).End(xlUp).Row
' Build range of first column dinamically
Dim firstColumnRange As Range
Set firstColumnRange = targetSheet.Range(firstColumnLetter & firstColumnStartRow & ":" & firstColumnLetter & firstColumnlastRow)
' Loop through first column range cells
Dim valueCell As Range
For Each valueCell In firstColumnRange
' Check if cell contains "," in the second position in string
If InStr(valueCell.Value, ",") = 2 Then
' Store first digit of cell before ","
Dim firstDigit As Integer
firstDigit = Split(valueCell.Value, ",")(0)
' Check if cell contains "," in the fourth position in string
If InStr(3, valueCell.Value, ",") = 4 Then
' Store second digit of cell after ","
Dim secondDigit As Integer
secondDigit = Split(valueCell.Value, ",")(1)
End If
' Store second colum type
Dim secondColumnType As String
secondColumnType = valueCell.Offset(, 1).Value
' Store third column value
Dim thirdColumnValue As String
thirdColumnValue = valueCell.Offset(, 2).Value
' Store nodes values (first digit and second column type)
Select Case secondColumnType
Case "Node"
Dim nodeValues() As Variant
Dim nodeCounter As Long
ReDim Preserve nodeValues(nodeCounter)
nodeValues(nodeCounter) = Array(firstDigit, thirdColumnValue)
nodeCounter = nodeCounter + 1
Case "Arrow"
Dim matchedNodeFirstValue As String
Dim matchedNodeSecondValue As String
matchedNodeFirstValue = IsInArrayReturnItem(firstDigit, nodeValues)(1)
matchedNodeSecondValue = IsInArrayReturnItem(secondDigit, nodeValues)(1)
If matchedNodeFirstValue <> vbNullString And matchedNodeSecondValue <> vbNullString Then
valueCell.Offset(, 3).Value = matchedNodeFirstValue & Space(1) & thirdColumnValue & Space(1) & matchedNodeSecondValue
End If
End Select
End If
Next valueCell
CleanExit:
Exit Sub
CleanFail:
Debug.Print "Something went wrong: " & Err.Description
Resume CleanExit
End Sub
' Credits: https://stackoverflow.com/a/38268261/1521579
Public Function IsInArrayReturnItem(stringToBeFound As Integer, arr As Variant) As Variant
Dim i
For i = LBound(arr) To UBound(arr)
If arr(i)(0) = stringToBeFound Then
IsInArrayReturnItem = arr(i)
Exit Function
End If
Next i
IsInArrayReturnItem = Array(vbNullString, vbNullString)
End Function
Let me know if it works
It appears that you are concatenating the lookups based on the
first and second integers,
where the second column = "Arrow"
If that is the case, I suggest:
Read the data table into a VBA array for faster processing
I am assuming your data is ordered as you show it, with all the Node entries at the start.
if that is not the case, then loop twice -- once to find the Nodes, and second time to concatenate the Arrow data.
Read the diagnoses into a dictionary for fact lookup.
if column2 = "Arrow" then concatenate the lookups of the first and second integers
Write back the data
Note: As written, this will overwrite the original table destroying any formulas that might be there. If needed, you could easily modify it to only overwrite the necessary area.
Note2 Be sure to set a reference (under Tools/References) to Microsoft Scripting Runtime, or change the Dictionary declaration to late-binding.
Regular Module
'set reference to Microsoft Scripting Runtime
Option Explicit
Sub Dx()
Dim WS As Worksheet
Dim rngData As Range, c As Range, vData As Variant
Dim dDx As Dictionary
Dim I As Long, sKey As String, dxKeys As Variant
'Get the data range
Set WS = ThisWorkbook.Worksheets("sheet1")
With WS
'assume table starts in A1 and is three columns wide
Set rngData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=3)
'read into variant array for faster processing
vData = rngData
End With
'create dictionsry for dx lookups
Set dDx = New Dictionary
For I = 2 To UBound(vData, 1)
Select Case vData(I, 2)
Case "Node"
sKey = Split(vData(I, 1), ",")(0) 'first comma-separated number
If dDx.Exists(sKey) Then
MsgBox "duplicate diagnostic key. Please correct the data"
Exit Sub
End If
dDx.Add Key:=sKey, Item:=vData(I, 3)
Case "Arrow"
dxKeys = Split(vData(I, 1), ",")
vData(I, 3) = dDx(dxKeys(0)) & " + " & dDx(dxKeys(1))
End Select
Next I
'reWrite the table
Application.ScreenUpdating = False
rngData = vData
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 ;)
I am trying to get the values of the visible cells of a range into an array.
My code makes the array carry the values until the first non visible cell then stops.
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
ListeMaschinen = Auswahl
End Function
If I select the range it shows all the cells I want marked.
Auswahl.Select
Here I have added the range cells to an array.
Sub examp()
Dim rng As Range, cll As Range, i As Integer, a(100) As Variant
Set rng = Range(Range("A2:B2"), Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
i = 0
For Each cll In rng
a(i) = cll.Value
i = i + 1
Next
End Sub
In your code, you are setting a Variant variable equal to a Range object without using the Set statement.
The following works with the little testing I did. Of course, if you declare the function type and other variables as Range type, it also works.
Option Explicit
Sub test()
Dim myVar As Variant
Set myVar = myList()
Debug.Print myVar.Address
End Sub
Public Function myList() As Variant
Dim myRng As Range
With Sheets("Sheet1")
Set myRng = .Range(.Range("A1:B1"), .Range("A1:B1").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
Debug.Print myRng.Address
Set myList = myRng
End Function
I think your issue is related to
.SpecialCells(xlCellTypeVisible)
When I do this:
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
MsgBox Auswahl.Address
Set ListeMaschinen = Auswahl
'Auswahl.Select
End Function
I get an Address composed of 2 parts: the visible parts!
But when I remove the SpecialCells
Public Function ListeMaschinen() As Variant
Dim Auswahl As Range
With Sheets("qry_TechnischesDatenblatt")
Set Auswahl = .Range(.Range("A2:B2"), .Range("A2:B2").End(xlDown))
End With
MsgBox Auswahl.Address
Set ListeMaschinen = Auswahl
End Function
I get one single part, which Is what I get when using Select too.
I tested!
Sub test()
Dim myVar As Variant
Dim i As Integer
i = 0
Set myVar = ListeMaschinen()
For Each C In myVar
i = i + 1
MsgBox C.Value & C.Address & "-" & i
Next
End Sub
Further to my comments earlier, here is a method that will work subject to some limitations:
You can't have more than 65536 rows of data; and
You can't have really long text (911 chars+), or blank visible cells; and
The data should not contain the string "|~|"
If those conditions are met, you can use something like this:
Dim v
Dim sFormula As String
With Selection
sFormula = "IF(SUBTOTAL(103,OFFSET(" & .Cells(1).Address(0, 0) & ",row(" & .Address(0, 0) & ")-min(row(" & .Address(0, 0) & ")),1))," & .Address(0, 0) & ",""|~|"")"
End With
Debug.Print sFormula
v = Filter(Application.Transpose(Evaluate(sFormula)), "|~|", False)
You can adapt this to work round the third limitation by changing the alternate text in the formula string.
Hello :) I was trying to find a way to loop through visible rows in a table without going through all the rows and checking if they are visible as this was consuming too much time on a large table. Below is the solution I was able to come up with. It is a function that returns an array of the absolute row numbers of visible rows in a given Range.
Function GetVisibleRows(LookupRange As Range) As Integer()
Dim VisibleRange As Range, Index As Integer, Area As Range
Static VisibleRows() As Integer
Set VisibleRange = LookupRange.SpecialCells(xlCellTypeVisible)
ReDim VisibleRows(0)
Index = 0
For Each Area In VisibleRange.Areas
If Index = 0 Then
VisibleRows(Index) = Area.Row
ReDim Preserve VisibleRows(Index + 1)
End If
Index = UBound(VisibleRows())
If VisibleRows(Index - 1) <> Area.Row Then
VisibleRows(Index) = Area.Row
ReDim Preserve VisibleRows(Index + 1)
End If
Next
' Remove last empty item
ReDim Preserve VisibleRows(UBound(VisibleRows()) - 1)
GetVisibleRows = VisibleRows
End Function
If you would like to use this function in a lookup scenario, you need to convert the absolute row numbers returned by the function to relative row numbers of the table. Following worked for me.
RowIndex = ReturnedRowIndex - LookupRange.Rows(1).Row + 1
Good luck!
I have an Excel table in which sometimes an entire cell has the following content:
pos=51;70;112;111;132;153
Note the whole content in in a single cell, that is to say the value 51;70;112... are strings clumped together in a single cell and not in their own cells.
Can I write a macro that in all cells that contain the keyphrase "pos=", add 2 to each value, so that the end result is:
pos=53;72;114;113;134;155
Here is a code that will do it (tested on a sample on my Excel 2003):
Sub t()
Dim rCells As Range, c As Range
Dim arr As Variant, i As Integer
'Define the range to apply the code
Set rCells = Range("A1")
For Each c In rCells
'check if the cell desserves to be changed (could be adapted though to another check)
If Left(c.Value, 4) = "pos=" Then
'split all the values after the "pos=" into an array
arr = Split(Mid(c.Value, 5, Len(c.Value)), ";")
'add +2 to every value of the array (we convert the value to be sure, probably unneeded)
For i = 0 To UBound(arr)
arr(i) = CLng(arr(i)) + 2
Next i
'set back the value to the worksheet
c.Value = "pos=" & Join(arr, ";")
End If
Next c
End Sub
Note that I didn't add the error checking part if your values aren't well formated.
You know that you can easily split data without using macros, right? Just use the TextToColumns function on the Data tab
But if you really want a macro, you can do something like the following:
Sub AddNumber()
Dim numberToAdd As Integer
numberToAdd = 2
Set myRange = Range("A1:A5")
For Each myCell In myRange
If Left(myCell.Value, 4) = "pos=" Then
arEquality = Split(myCell, "=")
arElements = Split(arEquality(1), ";")
For i = 0 To UBound(arElements)
arElements(i) = arElements(i) + numberToAdd
Next
myCell.Offset(0, 1).Value = arEquality(0) + "=" + Join(arElements, ";")
End If
Next
End Sub