VBA Find and Replace Part of a URL

[tomgrandy]

Here is my dilemma that might seem easy to you all, but am unsure how to write a VBA to accomplish.

I have a cell that I need to do a find and replace on up to the very last part (/1.jpg, /2.jpg, etc.)

The original cell info is as follows:

https://images.sitename.com/AuctionImages/3173/239780/FullSize

/1.jpg

https://images.sitename.com/AuctionImages/3173/239780/FullSize/2.jpg

https://images.sitename.com/AuctionImages/3173/239780/FullSize/3.jpg

What I need it to do when the VBA runs is rename it to (URL and path in blue to identify what needs replaced.

sites/default/files/images/auctions/AUCTION_DATE/1.jpg
sites/default/files/images/auctions/AUCTION_DATE/2.jpg
sites/default/files/images/auctions/AUCTION_DATE/3.jpg

Thanks in advance!

 

[tomgrandy]

Where the above gets tricky, is the /3173/239780/ changes numbers throughout the worksheet so I don't know if you can do a wildcard like:

https://images.sitename.com/AuctionImages/*/FullSize/2.jpg

Since the rest of the URL will always remain the same.

The AUCTION_DATE I have a script that will grab that date of the auction from another cell thanks to the help from users here.

 

[tomgrandy]

Maybe something along these lines:

Sub test()
    Dim hLink As Hyperlink
    Dim wSheet As Worksheet

    For Each wSheet In Worksheets
       For Each hLink In wSheet.Hyperlinks
            hLink.Address = Replace(hLink.Address, "[URL]https://images.sitename.com/AuctionImages/3173/239780/FullSize/2.jpg[/URL]", "sites/default/files/images/auctions/AUCTION_DATE/1.jpg")
        Next hLink
    Next
End Sub

However, that still doesn't address the /3173/239780/ portion being a different auction and lot number throughout the worksheet

 

[tomgrandy]

Tried again with a Range of cells in L column, but still getting errors:

Sub ChangeURL()

    Dim hLink As Hyperlink

    Dim cell As Range

    For Each cell In Range("l2:l70000")

            hLink.Address = Replace(hLink.Address, "https://images.SITENAME.com/AuctionImages/3173/239780/FullSize/2.jpg", "sites/default/files/images/auctions/AUCTION_DATE/1.jpg")

        Next cell

    Next

End Sub
Sub ChangeURL()

    Dim hLink As Hyperlink

    Dim cell As Range

    For Each cell In Range("l2:l70000")

            hLink.Address = Replace(hLink.Address, "https://images.SITENAME.com/AuctionImages/3173/239780/FullSize/2.jpg", "sites/default/files/images/auctions/AUCTION_DATE/1.jpg")

        Next cell

    Next

End Sub

 

[tomgrandy]

Not having much luck, but did find what looked like it could be a similar situation here through searching past posts.

However, it doesn't change anything when I run it:

Sub AlterHyperlinks()
  Dim c As Range
  Dim pos As Long
  Dim tmp As String
  
  Const sNewPath As String = "sites/default/files/images/auctions/AUCTION_DATE/1.jpg"
  
  For Each c In Range("L3", Range("L" & Rows.Count).End(xlUp))
    If c.Hyperlinks.Count > 0 Then
      tmp = c.Hyperlinks(1).Address
      pos = InStrRev(tmp, "\", InStrRev(tmp, "\") - 1)
      If pos > 0 Then c.Hyperlinks(1).Address = sNewPath & Mid(tmp, pos)
    End If
  Next c

End Sub

 

[Burrgogi]

What I need it to do when the VBA runs is rename it to (URL and path in blue to identify what needs replaced.

Your question is unclear. What do you mean by "...what needs replaced."?

Are you say that you want to turn this string: https://images.sitename.com/AuctionImages/3173/239780/FullSize/2.jpg

Into this?:
https://images.sitename.com/AuctionImages/3173/239780/FullSize

Rephrase your question and give an example of the result you expect to see.

 

[tomgrandy]

I am trying to change this string:

https://images.sitename.com/AuctionImages/3173/239780/FullSize/1.jpg

Into this:

sites/default/files/images/auctions/AUCTION_DATE/1.jpg

so instead of a URL, it is becoming a path on a web server.

However, there are a series of them that need replaced (1.jpg, 2.jpg) AND that middle part of the first URL /3173/239780/ will be a different number after 450 entries to something.

 

[Burrgogi]

I am trying to change this string:

https://images.sitename.com/AuctionImages/3173/239780/FullSize/1.jpg

Into this:

sites/default/files/images/auctions/AUCTION_DATE/1.jpg

Here is a formula that you can incorporate into a VBA routine:

=SUBSTITUTE(A1, A1, "sites/default/files/images/auctions/AUCTION_DATE/"&TRIM(RIGHT(SUBSTITUTE(A1,"/",REPT(" ",50)),50)))

Adjust "A1" in the formula to the actual column in your workbook that contains the URLs

Also this assumes that your filenames (*.jpg) are no longer than 50 characters. If they are longer than that, you can adjust them as necessary -- see the tail end of the formula. (If I'm not mistaken the maximum is 255 characters).

 

[Burrgogi]

This is a VBA routine that incorporates the above formula.

You did not mention what columns you're using. I wrote the following macro based on the assumption that the original URL is contained in col. A and the row of data starts at row 2. The results will appear in col. B. If your setup is different from this, you'll need to clarify.

Sub Fix_string()
Range("B2").FormulaR1C1 = "=SUBSTITUTE(RC1, RC1, ""sites/default/files/images/auctions/AUCTION_DATE/""&TRIM(RIGHT(SUBSTITUTE(RC1,""/"",REPT("" "",50)),50)))"
    With Range("B2", "B" & Cells(Rows.Count, 1).End(xlUp).Row)
        .FillDown
        .Value = .Value
    End With
End Sub

 

[Akuini]

Another option to try:

Sub tomgrandy_1()
Dim i As Long
Dim c As Range
Dim tx As String
Dim va, ary

va = Range("A1", Cells(Rows.Count, "A").End(xlUp))
tx = "sites/default/files/images/auctions/AUCTION_DATE/"
For i = 1 To UBound(va, 1)
    ary = Split(va(i, 1), "/")
    va(i, 1) = tx & ary(UBound(ary))
Next
Range("B1").Resize(UBound(va, 1), 1) = va
End Sub

Example:

Book1
	A	B
1	https://images.sitename.com/AuctionImages/3173/239780/FullSize/1.jpg	sites/default/files/images/auctions/AUCTION_DATE/1.jpg
2	https://images.sitename.com/AuctionImages/3173/239780/FullSize/2.jpg	sites/default/files/images/auctions/AUCTION_DATE/2.jpg
3	https://images.sitename.com/AuctionImages/1111/239780/FullSize/3.jpg	sites/default/files/images/auctions/AUCTION_DATE/3.jpg
4	https://images.sitename.com/AuctionImages/3333/222222/FullSize/4.jpg	sites/default/files/images/auctions/AUCTION_DATE/4.jpg
Sheet4