VBA code for deleting some values on a multiple cells.

[usui]

I have a worksheet that has cells with links. is there a vba code for remove the existing values after the word " jpg" ??.

I have multiple cells with this kind of links and removing the existing values after jpg is really a pain by doing it manually one after another..

Please help me. see sample below.



Original link:
https://www.google.com/url?sa=i&url=https%3A%2F%2Ffunnygamerpicskartun.blogspot.com%2F2020%2F02%2Ffunny-photos-jpg.html&psig=AOvVaw2fCTEmOcnWOybql0VEpgGb&ust=1621929431930000&source=images&cd=vfe&ved=0CAIQjRxqFwoTCJjdvZDs4fACFQAAAAAdAAAAABAD


Into link this:
https://www.google.com/url?sa=i&url=https%3A%2F%2Ffunnygamerpicskartun.blogspot.com%2F2020%2F02%2Ffunny-photos-jpg

 

[Alex Blakenburg]

See if this does what you need:-

Sub TruncateBasedOnFindStr()

    Dim findStr As String
    Dim foundCell As Range
    Dim firstMatch As String
       
    findStr = "-jpg"
    Set foundCell = Cells.Find(what:=findStr, LookIn:=xlFormulas, MatchCase:=False, lookat:=xlPart)
    firstMatch = foundCell.Address
   
    Do While Not foundCell Is Nothing
        foundCell = Left(foundCell.Value, InStr(foundCell.Value, findStr) + Len(findStr) - 1)
        Set foundCell = Cells.FindNext(foundCell)
        If firstMatch = foundCell.Address Then Exit Do

    Loop

End Sub

 

[usui]

See if this does what you need:-

Sub TruncateBasedOnFindStr()

    Dim findStr As String
    Dim foundCell As Range
    Dim firstMatch As String
      
    findStr = "-jpg"
    Set foundCell = Cells.Find(what:=findStr, LookIn:=xlFormulas, MatchCase:=False, lookat:=xlPart)
    firstMatch = foundCell.Address
  
    Do While Not foundCell Is Nothing
        foundCell = Left(foundCell.Value, InStr(foundCell.Value, findStr) + Len(findStr) - 1)
        Set foundCell = Cells.FindNext(foundCell)
        If firstMatch = foundCell.Address Then Exit Do

    Loop

End Sub

Hi Alex, thank you so much for the vba code. its working perfectly..now may only issue is to remove the specific words in the link..it would be very helpful if i can just enter the word on a pop up box or something, since not always the same words will be remove..please see the sample below.

Old link:

https://cdn.shopify.com/s/files/1/0021/3041/1580/products/2_fe23ca6f-14a5-4fa4-9900-f963803d43c5_2048x.progressive.jpg

Into this link:
2_fe23ca6f-14a5-4fa4-9900-f963803d43c5_2048x.progressive.jpg

is there a way for a pop up box to just input this words " https://cdn.shopify.com/s/files/1/0021/3041/1580/products/ " or any words that i need to remove?..

Please help me

 

[Alex Blakenburg]

Give this a try.
You can put multiple words into the input box as long as you separate them with a comma

Sub TruncateBasedOnFindStr()

    Dim findStr As String
    Dim foundCell As Range
    Dim firstMatch As String
    Dim inputWords As String
    Dim arrWords() As String
    Dim strWord As Variant
    
    inputWords = InputBox(Title:="Word List", prompt:="Comma separated list of words", Default:="-jpg")
    
    If inputWords <> "" Then
        
        arrWords = Split(inputWords, ",")
            
        For Each strWord In arrWords
            findStr = Trim(strWord)
            Set foundCell = Cells.Find(what:=findStr, LookIn:=xlFormulas, MatchCase:=False, lookat:=xlPart)
            firstMatch = foundCell.Address
            
            Do While Not foundCell Is Nothing
                foundCell = Left(foundCell.Value, InStr(foundCell.Value, findStr) + Len(findStr) - 1)
                Set foundCell = Cells.FindNext(foundCell)
                If firstMatch = foundCell.Address Then Exit Do
        
            Loop
        Next strWord
        
    End If

End Sub

 

[usui]

Give this a try.
You can put multiple words into the input box as long as you separate them with a comma

Sub TruncateBasedOnFindStr()

    Dim findStr As String
    Dim foundCell As Range
    Dim firstMatch As String
    Dim inputWords As String
    Dim arrWords() As String
    Dim strWord As Variant
   
    inputWords = InputBox(Title:="Word List", prompt:="Comma separated list of words", Default:="-jpg")
   
    If inputWords <> "" Then
       
        arrWords = Split(inputWords, ",")
           
        For Each strWord In arrWords
            findStr = Trim(strWord)
            Set foundCell = Cells.Find(what:=findStr, LookIn:=xlFormulas, MatchCase:=False, lookat:=xlPart)
            firstMatch = foundCell.Address
           
            Do While Not foundCell Is Nothing
                foundCell = Left(foundCell.Value, InStr(foundCell.Value, findStr) + Len(findStr) - 1)
                Set foundCell = Cells.FindNext(foundCell)
                If firstMatch = foundCell.Address Then Exit Do
       
            Loop
        Next strWord
       
    End If

End Sub

Hi Alex, thank you for the response. i have tried your new code but unfortunately it functions the same with the first vba code you send..what i need is that it will remove from "word" going to the left where the input word is in the right..please see the snapshot below.

The word "products" is sample keyword, and i want to remove the existing words or phrases on its left side.

please help you have a code for this..

 

[Alex Blakenburg]

You know that is the exact opposite of what you had in the original posting don't you.

Try this:

Sub RemoveLeftFindStr()

    Dim findStr As String
    Dim foundCell As Range
    Dim firstMatch As String
    Dim inputWords As String
    Dim arrWords() As String
    Dim strWord As Variant
    
    inputWords = InputBox(Title:="Word List", prompt:="Comma separated list of words")
    
    If inputWords <> "" Then
        
        arrWords = Split(inputWords, ",")
            
        For Each strWord In arrWords
            findStr = Trim(strWord)
            Set foundCell = Cells.Find(what:=findStr, LookIn:=xlFormulas, MatchCase:=False, lookat:=xlPart)
            If Not foundCell Is Nothing Then
                firstMatch = foundCell.Address
                Debug.Print foundCell.Address, foundCell.Text
                
                Do While Not foundCell Is Nothing
                    foundCell = Right(foundCell.Value, Len(foundCell.Value) - InStr(foundCell.Value, findStr) + 1)
                    Set foundCell = Cells.FindNext(foundCell)
                    'Debug.Print foundCell.Address, foundCell.Text
                    If firstMatch = foundCell.Address Then Exit Do
            
                Loop
            End If
        Next strWord
        
    End If

End Sub

 

[usui]

You know that is the exact opposite of what you had in the original posting don't you.

Try this:

Sub RemoveLeftFindStr()

    Dim findStr As String
    Dim foundCell As Range
    Dim firstMatch As String
    Dim inputWords As String
    Dim arrWords() As String
    Dim strWord As Variant
   
    inputWords = InputBox(Title:="Word List", prompt:="Comma separated list of words")
   
    If inputWords <> "" Then
       
        arrWords = Split(inputWords, ",")
           
        For Each strWord In arrWords
            findStr = Trim(strWord)
            Set foundCell = Cells.Find(what:=findStr, LookIn:=xlFormulas, MatchCase:=False, lookat:=xlPart)
            If Not foundCell Is Nothing Then
                firstMatch = foundCell.Address
                Debug.Print foundCell.Address, foundCell.Text
               
                Do While Not foundCell Is Nothing
                    foundCell = Right(foundCell.Value, Len(foundCell.Value) - InStr(foundCell.Value, findStr) + 1)
                    Set foundCell = Cells.FindNext(foundCell)
                    'Debug.Print foundCell.Address, foundCell.Text
                    If firstMatch = foundCell.Address Then Exit Do
           
                Loop
            End If
        Next strWord
       
    End If

End Sub

Hi Alex,

Sorry for the confusion, we actually have to remove some words either from the left or right side of the input word, depending on the link we have.

The vba code you provided was super amazing and working so fine..i really appreciate your help on this and thank you so much about the help.


I do have another problem that is still pending until now...i don't know if you can also help with this.

i am looking for a vba code for removing certain columns or multiple columns with a value..and would be fast if it also have a pop up inputbox to enter the words or values of the columns,

sample: columns
A : head
B: knee
C: toe
D: finger
E: arm
F: back
G: legs
H: stomach

and i wanted to delete the columns B, D, E, G at the same time by just entering the keywords on the pop up box.

Do you have any idea of a vba code for this concern?

 

[Alex Blakenburg]

You really need to post it as a separate question.
You get the best results when posting if you if you include an XL2BB sample of the before and another of how you want it to look after.
a) it makes it clear what the starting point, including sheet names and cell references
b) it means the person answering does not have to spend time creating sample data
c) it makes it clear what the end result should be.

**************************************************************************************************
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.
**************************************************************************************************