Trim, Copy (insert), Concatenate on selected range - excel

Question

I have a one dimensional column of cells containing text.
I would like to:
strip ".jpg" extension
duplicate each line and insert a copy of the duplicated line beneath it
for each duplicated line (every second line), add a suffix "-Alpha"
apply ".tif" extension to all of the cells
Data looks like this:
0120-052.jpg
0120-053.jpg
0120-054.jpg
0120-055.jpg
0120-056.jpg
I would like to select that range and it appear like so:
0120-052.tif
0120-052-Alpha.tif
0120-053.tif
0120-053-Alpha.tif
0120-054.tif
0120-054-Alpha.tif
0120-055.tif
0120-055-Alpha.tif
0120-056.tif
0120-056-Alpha.tif
I found out how to insert entire rows between the existing data, but I have other data to the left of this data and don't want to have blank rows running across my entire spreadsheet. I did find a way to insert blanks between the existing data but I could not figure out how to instead paste the data when inserting. I fudged something together, but it tried to paste infinitely.
I think I need to put it all into an array and iterate on a step by step basis, but I was unable to figure out how to do that based off of an arbitrary selection.
Sub PasteInsertRowsAfter()
Dim MyCell As Range
For Each MyCell In Selection
If MyCell.Value <> "" Then
MyCell.Copy
MyCell.Offset(1, 0).Insert shift:=xlDown
MyCell.Offset(2, 0).Select
End If
Next MyCell
End Sub

Answer 1

Does this work for you?
Sub PasteInsertRowsAfter()
Dim i As Long
Dim MyCell As Range
Dim Rng As Range
Set Rng = Selection
For i = Rng.Cells.Count To 1 Step -1
Set MyCell = Rng.Cells(i)
MyCell.Copy
MyCell.Offset(1, 0).Insert shift:=xlDown
MyCell.Value = Replace(MyCell.Value, ".jpg", ".tif")
MyCell.Offset(1, 0).Value = Replace(MyCell.Offset(1, 0), ".jpg", "-Alpha.tif")
Next i
End Sub

Answer 2

This sounds like bad data structure to me (inserting rows) so this solution will be based on a column structured table. However, I don't know much else about the data so this could be a wrong assumption on my end.
You could store your values in columns instead like so | Original String | .jpg | -Alpha.tif |
Where Original String is the header for Column A and so on. Your data will be better organized this way since all modifications of original string will be stored on a single row. This structure will allow you to add other info that may be relevant at some point in time (source, date, etc.). You can create pivots with this format and monitor for duplicates easier. You can even store the original string.
Input/Output of macro are below.
This sub is a simple loop that does not take a Slection range.
Sub Alternative()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim MyRange As Range: Set MyRange = ws.Range("A2:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
Dim MyCell As Range
Application.ScreenUpdating = False
For Each MyCell In MyRange
MyCell.Offset(, 1) = Replace(MyCell, "jpg", "tif")
MyCell.Offset(, 2) = Replace(MyCell, ".jpg", "-Alpha.tif")
Next MyCell
Application.ScreenUpdating = True
End Sub
Here is an option that allows the user to select a range once the macro is launched. Just as the above solution, the macro will output the data in the 2 columns to left of selected range.
Sub Alternative()
Dim MyRange As Range, MyCell As Range
On Error Resume Next 'Allow for Cancel Button
Set MyRange = Application.InputBox("Select Range", Type:=8)
On Error GoTo 0
If Not MyRange Is Nothing Then
Application.ScreenUpdating = False
For Each MyCell In MyRange
MyCell.Offset(, 1) = Replace(MyCell, "jpg", "tif")
MyCell.Offset(, 2) = Replace(MyCell, ".jpg", "-Alpha.tif")
Next MyCell
Application.ScreenUpdating = True
End If
End Sub

Answer 3

Trim160ConcatArrayPaste
Option Explicit
'With Sub ======================================================================
' .Title: Trim160ConcatArrayPaste
' .Author: YMG
'-------------------------------------------------------------------------------
Sub Trim160ConcatArrayPaste()
'Description
' Manipulates data in a selected worksheet range and pastes the result into
' another range (overwriting the former range and more).
'Parameters
' None
'Returns
' Manipulated data in a range.
'
'-- Customize BEGIN --------------------
Const cStr1 As String = ".jpg"
Const cStr2 As String = ".tif"
Const cStr3 As String = "-Alpha.tif"
'If the result should be pasted into another row. Probably useless.
Const loROff As Long = 0 'Row Offset for Array Data
''''''''''''''''''''''''''''''''''''''''
'If the result should be pasted into another column
Const iCOff As Integer = 0 'Column Offset for Array Data
'Remarks:
' I strongly urge you to consider pasting the data into another column e.g.
' the column adjacent to the right of the starting column (Set iCoff = 1).
' If something goes wrong while pasting you will overwrite your initial data
' and you might lose a lot of time getting it back.
' Creating a log file might be considered.
''''''''''''''''''''''''''''''''''''''''
'
'-- Customize END ----------------------
'
Dim oXL As Application 'Exel Application Object
Dim oWb As Workbook 'Workbook Object - ActiveWorkbook
Dim oWs As Worksheet 'Worksheet Object - ActiveSheet
Dim oRng As Range 'Range Object - Range to read from, Range to write to
Dim oCell As Range 'Cell - Range Object - All cells of oRng
Dim arrTCC() As String
Dim lo1 As Long 'Data Entries Counter, Array Entries Counter
Dim strCell As String
Dim strArrRng As String
'
'-------------------------------------------------------------------------------
'Assumptions
' There is a contiguous range (oRng) in the ActiveSheet (oWs) of the
' ActiveWorkbook (oWb) that contains a list of entries in its cells
' (oRng.Cells) to be processed. ('Data' for 'list of entries' in further text)
' The actual range of the Data is selected.
'-------------------------------------------------------------------------------
'
Set oXL = Application
Set oWb = ActiveWorkbook
Set oWs = oWb.ActiveSheet
Set oRng = oXL.Selection
'
'Remarks:
' The Selection Property is a property of the Application object and the
' Window object. Visual Basic doesn't allow ActiveWorkbook.Selection or
' ActiveSheet.Selection.
'
''''''''''''''''''''''''''''''''''''''''
'Task:
' Count the number of Data entries.
'
lo1 = 0 'Data Entries Counter
For Each oCell In oRng.Cells
lo1 = lo1 + 1
Next
'
'Status:
' 'lo1' is the number of Data entries which will be used to determine the
' size of an array in the following code.
'
''''''''''''''''''''''''''''''''''''''''
'Task: Populate an array with the desired results.
'
ReDim arrTCC(1 To lo1 * 2, 1 To 1)
'Explaination:
'"lo1" - Number of list entries.
'" * 2" - Making 2 entries out of each entry.
lo1 = 0 'Array Entries Counter (This is a 1-based array.)
For Each oCell In oRng.Cells
'Clean the text of the Data entries.
strCell = Trim(oCell.Text)
'Remarks:
'Chr(160) which is a non-breaking space (HTML Name: ) is at
'the end of the Data entries. The Trim function doen't clean
'non-breaking spaces.
strCell = Replace(strCell, Chr(160), "")
'Check the last part of the string
If Right(strCell, Len(cStr1)) = cStr1 Then
'Populate array.
lo1 = lo1 + 1
arrTCC(lo1, 1) = Replace(strCell, cStr1, cStr2)
lo1 = lo1 + 1
arrTCC(lo1, 1) = Replace(strCell, cStr1, cStr3)
'If the cell doesn't end with cStr1:
Else 'This should never happen, remember: COUNTIGUOUS.
'An Idea
' lo1 = lo1 + 1
' arrTCC(lo1, 1) = ""
' lo1 = lo1 + 1
' arrTCC(lo1, 1) = ""
MsgBox "You might have selected a wrong range.", vbCritical
Exit Sub
End If
Next
'
' For lo1 = LBound(arrTCC) To UBound(arrTCC)
' Debug.Print arrTCC(lo1, 1)
' Next
' Debug.Print LBound(arrTCC)
' Debug.Print UBound(arrTCC)
'
'Status: The array 'arrTCC' is populated
'
''''''''''''''''''''''''''''''''''''''''
'Task:
' Determine the range where to paste the data from array and paste the
' array into the range.
'
'Calculate the 'Start' Cell Address
strArrRng = oRng.Cells(1 + loROff, 1 + iCOff).Address
'
' Debug.Print strArrRng
'
'Add the ":" (Address Separator) and the Calculated 'End' Cell Address
strArrRng = strArrRng & ":" & _
oRng.Cells(UBound(arrTCC) + loROff, 1 + iCOff).Address
'Paste the Array to the Worksheet
Set oRng = oWs.Range(strArrRng)
'
' Debug.Print strArrRng
' Debug.Print oRng.Address
'
oRng = arrTCC
'
'Status: Done
'
'Remarks:
'Testing the program was done with iCoff = 1 i.e. pasting the array data
'into the column adjacent to the right of the starting column. Since it uses
'overwriting the Data, the Data would always need to be written back for
'further testing.
'Some debugging code has deliberately been commented and left inside the
'program to remind amateurs like myself of debugging importance.
'Some other aspects of this program could be considered like the column
'of the data could be known or unknown so a range, a column or the
'ActiveCell would have or don't have to be selected etc.
'
End Sub
'-------------------------------------------------------------------------------
'With Source Idea --------------------------------------------------------------
' .Title: Excel VBA seemingly simple problem: Trim, Copy (insert), Concat on selected range
' .TitleLink: https://stackoverflow.com/questions/52548294/excel-vba-seemingly-simple-problem-trim-copy-insert-concat-on-selected-rang
' .Author: NewbieStackOr
' .AuthorLink: https://stackoverflow.com/users/10427336/newbiestackor
'End With ----------------------------------------------------------------------
'End With ======================================================================