Extract URLs from single cell that contains specified domain - excel

In excel, each cell in Column A has 1-6 urls in random order separated by ";".
I'm trying to extract urls from each domain, and place them in according columns.
http:/i.stack.imgur.com/J7UJg.jpg (// subbed with / to post)
For example, A2, would have the following,
http:/randomwebsite.com/content/mieIEe;
http:/examplesite.io/jiefaiwjf0293845983725kjsdaf;
http:/randomwebsite.com/img/fjioewqa;
https:/www.anotherrandomsite.com/watch=9hDEOjefls;
http:/www.anotherexample.com/5053/765437/qwreja;
http:/random.com/jfieJOJd344
B1 - F1 would each be columns for the different domains. B1 would be a column for randomwebsite.com, C1 would be for anotherrandomsite.com, .. and so forth.
The results I would want in this case is to have each corresponding url from column A, to show in each designated column. Like the first url "http:/randomwebsite.com/content/mieIEe" to show in B2, and if same domains come up twice or more, separate them with "," within the same cell as B2 would be "http:/randomwebsite.com/content/mieIE,http:/randomwebsite.com/img/fjioewqa".
I've tried putting the following in B2 and on..
=IFERROR(MID($A2,FIND(B$1,$A2),FIND("; ",$A2)-1),"")
&IFERROR("; "&MID($A2,FIND(B$1,$A2,FIND(B$1,$A2)+1),FIND("; ",$A2)-1),"")
Does kinda work, but I ran into a problem of determining the actual length of each url.
Main issues are:
some domains are listed twice or more
not all domains start with http/s www, or end with com
Would there be any standard function methods to solve this within a single cell?
I have no experience with VBA.

After looking at your post a little longer I realised that you want the URLS in column A to be distributed over the columns B to F and placed in the column having the domain name in its first row (B1:F1). The function you have provided is probably as good as it can be if you restrict yourself to worksheetfunctions.
I have put together a little VBA function that might do the job for you in a slightly different manner:
Function furl(urls, dom) ' filter URLs from string urls that belong to domain dom
Dim uarr, retval$, i%, j%
retval = ""
uarr = Split(urls, "; ")
For i = LBound(uarr) To UBound(uarr)
If (InStr(uarr(i), dom) > 0) Then retval = retval & "; " & uarr(i)
Next i
furl = Mid(retval, 3)
End Function
First I split the string into its individul urls using your separator "; ". I then run through all the resulting array elements in a for look and check for dom to appear there as a substring. If it does i add it to my retval string. This string is then returned by assigning it to the function itself (furl=mid(retval,3)). The mid(retval,3) removes the first two characters of the string.
You should "insert" a "Module" into the VBAproject of your current file and place the above code into that module. In your worksheet you can then use the function just like any other worksheetfunction like in cell B2:
=furl($a2,b$1)
In the column headers B1:F1 you should enter the minimum version of your URLs like 'randomwebsite.com', leaving out all optional stuff like 'http://' and 'www.'.
UPDATE
Yes, pnuts has a point with his comment!
I updated my function. Now it checks for possible word boundaries (any of the characters in "./") before and "/?#" after the given domain name:
Function furl(urls, dom) ' filter URLs from string urls that belong to domain dom
Dim uarr, retval$, i%, j%, lft$, ldom%
retval = ""
ldom = Len(dom)
uarr = Split(urls, "; ")
For i = LBound(uarr) To UBound(uarr)
j = InStr(uarr(i), dom)
If (j > 0) Then
' "word boundary"-char before the found position:
If (j = 1) Then lft = "." Else lft = Mid(uarr(i), j - 1, 1)
' right boundary left boundary
If (InStr("/?#", Mid(uarr(i), j + ldom, 1)) > 0 And InStr("./", lft)) Then
retval = retval & "; " & uarr(i)
End If
End If
Next i
furl = Mid(retval, 3)
End Function
I tested it and it works. Now I hope I can convince my downvoters to have mercy with me again ;-)
OR maybe, explain why they downvoted ...
OR maybe, even come up with a better solution - that would help us all!

Related

Extract URL from =Hyperlink()

I'm trying to extract the formula that is evaluated from a link generated with a formula:
=HYPERLINK("https://www.google.com/search?q="&A1&B1,"Link")
(A1 has vba and B1 has help)
I've seen many, many threads and even some SO threads with suggestions, but they only get me to the ...q= without considering I have more text to come.
The best luck I've had so far is from this thread, and I've tweaked it to search until B1 like this:
...
S = Left(S, InStr(S, "B17") + 2)
...
But it returns https://www.google.com/search?q="&A1&B1.
How can I get it to first evaluate what's in those cells, before returning the URL?
I was overthinking this I think. Thanks to #MacroMan for getting my head straight. I put together the following, rather clunky, macro.
Function hyperlinkText(rg As Range) As String
' Inspired by https://stackoverflow.com/questions/32230657/extract-url-from-excel-hyperlink-formula/32233083#32233083
Dim sFormula As String
Dim Test As String
sFormula = rg.Formula
Test = Mid(sFormula, WorksheetFunction.Search("""", sFormula), WorksheetFunction.Search(",", sFormula) - WorksheetFunction.Search("""", sFormula))
hyperlinkText = Evaluate("=" & Test)
End Function
This can take a URL that looks like:
=HYPERLINK("https://www.google.com/search?q="&A17&B17,"Link") and return the evaluated URL:

How to convert part of a cell value to bold

I have the below VBA code and A and B are holding some strings. I want to concatenate these values with some other strings and store the result in a different cell, but I want only the strings in A and B to be formatted as bold and the rest as normal text.
Set A = Worksheets("Mapping").Cells(rowNumber, columnNumber)
Set B = Worksheets("Mapping").Cells(rowNumber, 3)
' E.g.: A="currency", B="Small Int"
Worksheets("TestCases").Cells(i, 2) = "Verify the column " & A & " has same Data type " & B & " in code as well as Requirement document"
Expected output:
Verify the column currency has same Data type Small Int in code as well as Requirement document
Note: The values of A and B keep changing, so we cannot use the Characters() function.
Any help will be highly appreciated.
You can use the Characters() method - you just need to keep track of the length of the substrings. Personally, I would store the static strings in variables so that I can change them later without having to recalculate the indexes by hand:
' Untested
Set A = Worksheets("Mapping").Cells(rowNumber, columnNumber)
Set B = Worksheets("Mapping").Cells(rowNumber, 3)
Dim S1 = "Verify the column "
Dim S2 = " has same Data type "
Dim S3 = " in code as well as Requirement document"
With Worksheets("TestCases").Cells(i, 2)
.Value = S1 & A & S2 & B & S3
.Characters(Len(S1), Len(A)).Font.Bold
.Characters(Len(S1)+Len(A)+Len(S2), Len(B)).Font.Bold
End With
The function to change the font style is:
[Cells/Cell range].Font.FontStyle = "Bold"
Therefore something like might work:
Worksheets("Mapping").Cells(rowNumber, columnNumber).Font.FontStyle = "Bold"
You can also make things have underlines, strikethroughs etc... I found this really helpful blog post which goes through everything you should need to know:
http://software-solutions-online.com/excel-vba-formating-cells-and-ranges/#Jump4
I think you should have searched for this information yourself... Nevertheless this is the code that you should use to convert some cell data to bold:
Worksheets("Mapping").Cells(rowNumber, columnNumber).Font.Bold = True

How can I pick specific string fragments out of an excel cell using a custom formula written in VBA

At work I am required to reformat incorrect Addresses on a weekly basis from records in our Salesforce instance. We gather the incorrectly formatted addresses using a Report and export them to an Excel file. My job is simply to manipulate the data in the file to format them properly then reinsert them into the database.
Typically the addresses are formatted as so:
5 Sesame Street, Anytown, Anyplace
Separating these can be done easily by hand, but I typically have to work with hundreds of addresses at a time, and using default excel formulas tends to require lots of wrangling multiple cells at once to break it up into fragments.
Thus I wrote a custom formula to run through the cell and return a specific fragment of the string based on the "Comma Number" given. So if I give a Comma Number of 1, I would get "5 Sesame Street", 2 would get me "Anytown", etc.
Here is my code so far:
Public Function fragmentAddress(address As String, numberofcommas As Integer) As String
seen = 1
lastComma = -1
Dim x As Long
Dim frag As Long
For x = 0 To Len(address)
If Mid(address, x, 1) = "," & numberofcommas = seen Then
Exit For
ElseIf Mid(address, x, 1) = "," & numberofcommas <> seen Then
seen = seen + 1
lastComma = x
End If
Next
frag = Mid(address, lastComma + 1, seen - lastComma)
fragmentAddress = frag
I have not implemented the ability to handle the final value yet, but it does not give me any outputs, only outputting a "#VALUE!" error when I attempt to give it the input
=fragmentAddress("3 Ashley Close, Charlton Kings",1)
I have some experience with programming, but this is my first time writing anything in VBA.
Any help would be appreciated, thank you.
Not exactly sure what your question is, but this is simpler:
Public Function GetAddressFragment(ByVal Address As String, ByVal Index As Integer) As String
Dim addr() As String
addr = Split(Address, ",")
On Error Resume Next
GetAddressFragment = Trim(addr(Index - 1))
End Function

Remove text appearing between two characters - multiple instances - Excel

In Microsoft Excel file, I have a text in rows that appears like this:
1. Rc8 {[%emt 0:00:05]} Rxc8 {[%emt 0:00:01]} 2. Rxc8 {[%emt 0:00:01]} Qxc8 {} 3. Qe7# 1-0
I need to remove any text appearing within the flower brackets { and }, including the brackets themselves.
In the above example, there are three instances of such flower brackets. But some rows might have more than that.
I tried =MID(LEFT(A2,FIND("}",A2)-1),FIND("{",A2)+1,LEN(A2))
This outputs to: {[%emt 0:00:05]}. As you see this is the very first instance of text between those flower brackets.
And if we use this to within SUBSTITUTE like this: =SUBSTITUTE(A2,MID(LEFT(A2,FIND("}",A2)),FIND("{",A2),LEN(A2)),"")
I get an output like this:
1. Rc8 Rxc8 {[%emt 0:00:01]} 2. Rxc8 {[%emt 0:00:01]} Qxc8 {} 3. Qe7# 1-0
If you have noticed, only one instance is removed. How do I make it work for all instances? thanks.
Highlight everything
Go to replace
enter {*} in text to replace
leave replace with blank
This should replace all flower brackets and anything in between them
It is not that easy without VBA, but there is still a way.
Either (as suggested by yu_ominae) just use a formula like this and auto-fill it:
=IFERROR(SUBSTITUTE(A2,MID(LEFT(A2,FIND("}",A2)),FIND("{",A2),LEN(A2)),""),A2)
Another way would be iterative calculations (go to options -> formulas -> check the "enable iterative calculations" button)
To do it now in one cell, you need 1 helper-cell (for my example we will use C1) and the use a formula like this in B2 and auto-fill down:
=IF($C$1,A2,IFERROR(SUBSTITUTE(B2,MID(LEFT(B2,FIND("}",B2)),FIND("{",B2),LEN(B2)),""),B2))
Put "1" in C1 and all formulas in B:B will show the values of A:A. Now go to C1 and hit the del-key several times (you will see the "{}"-parts disappearing) till all looks like you want it.
EDIT: To do it via VBA but without regex you can simply put this into a module:
Public Function DELBRC(ByVal str As String) As String
While InStr(str, "{") > 0 And InStr(str, "}") > InStr(str, "{")
str = Left(str, InStr(str, "{") - 1) & Mid(str, InStr(str, "}") + 1)
Wend
DELBRC = Trim(str)
End Function
and then in the worksheet directly use:
=DELBRC(A2)
If you still have any questions, just ask ;)
Try a user defined function. In VBA create a reference to "Microsoft VBScript Regular Expressions 5.5. Then add this code in a module.
Function RemoveTags(ByVal Value As String) As String
Dim rx As New RegExp
rx.Global = True
rx.Pattern = " ?{.*?}"
RemoveTags = Trim(rx.Replace(Value, ""))
End Function
On the worksheet in the cell enter: =RemoveTags(A1) or whatever the address is where you want to remove text.
If you want to test it in VBA:
Sub test()
Dim a As String
a = "Rc8 {[%emt 0:00:05]} Rxc8 {[%emt 0:00:01]}"
Debug.Print RemoveTags(a)
End Sub
Outputs "Rc8 Rxc8"

Please assist with writing a Macro to clean up data entries

Quick question that should be easy enough for a lot of you but I'm not well versed in VBA or code in general for that matter but I have a problem that only a Macro or piece of VBA code can resolve for me. I have to edit a large number of data entries in a spreadsheet, cell by cell.
So on to the question. Could you please show me an example or provide a complete macro for me to use to edit these cells?
The editing that I require is as follows:
I need to read each cell in the following range: B2 to Q383. A typical entry that needs to be examined and edited looks like this: 629.64\3.00\01:30
What needs to happen now is for everything to the left of the first "\" and everything to the right of the second "\" needs to be removed, including the "\", from each cell.
I've tried fiddling around with the LEFT and RIGHT commands and I can output the data that needs to be removed from the cells with something like this
=left(B11, Find("\", B11) - 1)
So what would be the delete command in a macro to target that data selection in that cell? Or how do I use a delete command with those parameters?
Thanks in advance for any advice or answers!
Not 100% sure what you're after - you say you want to remove the bits from the left and right, but the formula returns the bit on the left.
Anyway, here's 3 formula to do it:
Left: =TRIM(LEFT(B11,FIND("\",B11)-1))
Middle: =LEFT(MID(B11,FIND("\",B11)+1,LEN(B11)),FIND("\",MID(B11,FIND("\",B11)+1,LEN(B11)))-1)
Right: =MID(B11,FIND("\",SUBSTITUTE(B11,"\","~",1))+1,LEN(B11))
And three VBA functions to do it
(use these as you would formula - =leftbit(B11), or if you're looking for something other than backslashes - =leftbit(B11,"|") will find the I-bar as a divider. )
Public Function LeftBit(target As Range, Optional Divider As String = "\") As String
LeftBit = Trim(Left(target, InStr(target, Divider) - 1))
End Function
Public Function MiddleBit(target As Range, Optional Divider As String = "\") As String
Dim First As Long, Second As Long
First = InStr(target, Divider)
Second = InStr(First + 1, target, Divider)
MiddleBit = Mid(target, First + 1, Second - First - 1)
End Function
Public Function RightBit(target As Range, Optional Divider As String = "\") As String
RightBit = Right(target, Len(target) - InStrRev(target, Divider))
End Function

Resources