CODEWITHSUNDEEP
vbaexcel
Vincent Tang
Vincent Tang

Reputation: 4170

Excel VBA - Replacing Values with a Regular Expression Function

I have a column in excel with unformatted image links. I've highlighted the image links in the raw data below

enter image description here

I need an excel VBA macro to convert data like so:

enter image description here

I wrote a regular expression http[s?]:\/\/.*(.png|.jpg) to pattern match the links. Sample:

enter image description here

I modified the function found here to do the processing

Function ExtractURL(ByVal text As String) As String

Dim result As String
Dim allMatches As Object
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")

RE.Pattern = "(http[s?]:\/\/.*(.png|.jpg))"
RE.Global = True
RE.IgnoreCase = True
Set allMatches = RE.Execute(text)

If allMatches.Count <> 0 Then
    result = allMatches.Item(0).submatches.Item(0)
End If

ExtractURL = result

End Function

How do I apply this function to replace the values in Column A?

EDIT: CLARIFICATION/CONTEXT

I have 1000+ image links. I simply showed 5 images to make the example straightforward. It needs to work only off of column A, since its part of a larger series of macros.

Upvotes: 0

Views: 4305

Answers (4)

DisplayName
DisplayName

Reputation: 13386

I've been always told that regexp slows things down

so here's a not-RegExp solution:

Sub main()
    With Range("A1", Cells(Rows.Count, 1).End(xlUp))
        .Replace what:="*https", replacement:="https", lookat:=xlPart
        .Replace what:=".JPG*", replacement:=".JPG", lookat:=xlPart
    End With
End Sub

and should you necessarily need a Function:

Function ExtractURL(text As String)    
    ExtractURL = Mid(Left(text, InStrRev(text, ".JPG", , vbTextCompare) + 3), InStr(1, text, "https", vbTextCompare))
End Function

Upvotes: 1

Vincent Tang
Vincent Tang

Reputation: 4170

Per my original post, this is what I used. With the extractURL function defined in my problem statement

Sub MainTest()

Range("A1").Activate
Do
    If ActiveCell.Value = "" Then Exit Do
    ActiveCell.Offset(1, 0).Activate
    argCounter = argCounter + 1
Loop

For row = 1 To argCounter + 1
    Cells(row, 1).Value = ExtractURL(Cells(row, 1).Value)
Next row

End Sub
  1. Dump code in module alt+f11
  2. Save
  3. View macro → MainTest

Upvotes: 0

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

If all you want is to replace column A with URLs only, you may try something like this...

Sub ExtractURL()
Dim lr As Long
Dim Rng As Range, Cell As Range
Dim RE As Object    

lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A1:A" & lr)

Set RE = CreateObject("vbscript.regexp")

With RE
    .Pattern = "(http[s?]:\/\/.*(.png|.jpg))"
    .Global = False
    .IgnoreCase = True
End With

For Each Cell In Rng
    If RE.test(Cell.Value) Then
        Cell.Value = RE.Execute(Cell.Value)(0)
    End If
Next Cell
End Sub

How to install your new code:

  • Copy the Excel VBA code
  • Select the workbook in which you want to store the Excel VBA code
  • Press Alt+F11 to open the Visual Basic Editor
  • On VB Editor, choose Insert --> Module
  • Paste the copied code into the opened code window
  • Save your workbook as Macro-Enabled Workbook.

To run the Excel VBA code:

  • Press Alt+F8 to open Macro list

  • Select the macro ExtractURL

  • Click on Run.

Note: If you want to place the output in another column, say column B, use this line instead...

Cell.Offset(0, 1).Value = RE.Execute(Cell.Value)(0)

Upvotes: 2

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60354

from old instructions I once wrote

To enter a User Defined Function (UDF):

  • alt-F11 opens the Visual Basic Editor.
  • Ensure your project is highlighted in the Project Explorer window.
  • Then, from the top menu, select Insert/Module and paste the code into the window that opens.

To use this User Defined Function (UDF), enter a formula like ExtractURL(cell_ref) in some cell.

Upvotes: 0

Related Questions