How do I auto add word to end of text in multiple columns using VBA?

Question

I am needing to add a .mp3 to the end of each entry in two columns. I have the code below which works but I have to select each item in the column and it applies it to those cells.

But I would like to have a code that would automatically add the .mp3 to the end of any entry in column B and D.

Here is my current code:

Sub AppendToExistingOnRight()
Dim c as range
For each c in Selection
  If c.value <> "" Then c.value = c.value & ".mp3”
Next
End Sub

Any assistance would be appreciate to help make this just a little more efficient.

score 1 · Answer 1 · answered Oct 20 '20 at 05:04

A solution without looping. I am showing it for columnB. Feel free to adapt it for column D

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim rng As Range
    Dim sAddr As String
    Dim lRow As Long
    
    '~~> Change sheet name as applicable
    Set ws = Sheet1
    
    With ws
        '~~> Find last row in Col B
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row
        
        '~~> Construct your range
        Set rng = Range("B1:B" & lRow)
        
        sAddr = rng.Address
        
        '~~> Append ".mp3" to the entire range in 1 go
        rng = Evaluate("index(concatenate(" & sAddr & ","".mp3""),)")
    End With
End Sub

In Action

If you would like to understand how this works then you may want to see Convert an entire range to uppercase without looping through all the cells

Mech · Answer 2 · 2020-10-20T03:01:27.880

I've added references to the workbook, worksheet, and set ranges which are then looped. I've also added a check to verify if ".mp3" already exists at the end of the cell. Finally, I prevented the screen from updating until the script has completed.

If you want it to run faster, specify the range (ie. ws.Range("B1:B1000") will check 1000 cells rather than 1048576).

Sub AppendToExistingOnRight()
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.ActiveSheet
Dim c As Range
Dim colB As Range: Set colB = ws.Range("B:B")
Dim colD As Range: Set colD = ws.Range("D:D")

For Each c In colB
  If c.Value <> "" And Right(c.Value, 4) <> ".mp3" Then c.Value = c.Value & ".mp3"
Next

For Each c In colD
  If c.Value <> "" Then c.Value = c.Value & ".mp3"
Next
Application.ScreenUpdating = True
End Sub

score 0 · Answer 3 · answered Oct 20 '20 at 03:05

Try below sub. If your data is same in Column B and Column D then you can use one loop.

Sub AddMP3()
Dim bRng As Range, dRng As Range, mRng As Range

Set bRng = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Set dRng = Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)

    For Each mRng In bRng
        mRng = mRng & ".mp3"
    Next

    For Each mRng In dRng
        mRng = mRng & ".mp3"
    Next

Set bRng = Nothing
Set dRng = Nothing
End Sub

How do I auto add word to end of text in multiple columns using VBA?

3 Answers3