CODEWITHSUNDEEP
excelvba
Akash Panchal
Akash Panchal

Reputation: 71

Remove certain characters from an entire piece of text in a column

I have a sheet named "AMP Sheet". Column heading for B1 is "Name". Under that column, I have image names with image extensions.

For example:

Name  
banana.png  
pear.jpg  
apple.gif  
etc.

I'm trying to remove the extension of images in the Name column.

The end-result I'm looking for:

Name  
banana  
pear  
apple  
etc.

This is what I've come up with:

With Sheets("AMP Sheet")
    Columns("B:B").Replace what:="*.png*", Replacement:="", LookAt:=xlPart, SearchOrder:=xlRows
End With

This logic does not work properly.

Also, instead of using Columns("B:B"), I would like to identify the column by it's header name, something like Column("Name").

Upvotes: 1

Views: 72

Answers (2)

Akash Panchal
Akash Panchal

Reputation: 71

This is what I ended up creating, and it works just fine for my use-case. Thank you everyone that helped, and I hope this helps you all!

Sub RemoveImageExtensions()

Dim sht As Worksheet
Dim fndpng As Variant
Dim rplc As Variant

fndpng = ".png"
rplc = ""

'Store a specfic sheet to a variable
  Set sht = ActiveWorkbook.Worksheets("AMP Sheet")

'Perform the Find/Replace All - .png'
  sht.Cells.Replace what:=fndpng, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False

End Sub

Upvotes: 0

VBasic2008
VBasic2008

Reputation: 55073

Remove File Extensions From File Names in Column

Option Explicit

Sub RemoveFileExtensions()

    Const wsName As String = "AMP Sheet"
    Const Header As String = "Name"
    Const HeaderRow As Long = 1
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    Dim hCol As Variant: hCol = Application.Match(Header, ws.Rows(HeaderRow), 0)
    If IsError(hCol) Then
        MsgBox "Column '" & Header & "' not found.", vbCritical
        Exit Sub
    End If
    
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, hCol).End(xlUp).Row
    If lRow <= HeaderRow Then
        MsgBox "No data in column '" & Header & "'.", vbCritical
        Exit Sub
    End If
    
    Dim rg As Range
    Set rg = ws.Range(ws.Cells(HeaderRow, hCol), ws.Cells(lRow, hCol))
    
    Dim Data As Variant: Data = rg.Value
    
    Dim r As Long
    Dim DotPosition As Long
    Dim CurrentString As String
    
    For r = 2 To UBound(Data, 1)
        CurrentString = CStr(Data(r, 1))
        DotPosition = InStrRev(CurrentString, ".")
        If DotPosition > 0 Then ' found a dot
            Data(r, 1) = Left(CurrentString, DotPosition - 1)
        'Else ' found no dot; do nothing
        End If
    Next r
    
    rg.Value = Data
    
    MsgBox "File extensions removed.", vbInformation
    
End Sub

Upvotes: 1

Related Questions