How to optimise my CONCATENATE vba script in Excel? - excel

Question

I've managed to put together a VBA script to automate the concatenating of strings in adjoining columns for the purpose of working with a Python/Applescript tool I've programmed for assisting with renaming of thousands of pdfs files.
There are four columns being worked on.
Col A - an article number for a particular computer in the organisation. 5 digits
Col B - the manufacturer's serial number for a given article number. Several digits long, but only the first 12 are important.
Col C - has a CONCATENATE function to derive the original name of a given PDF file related to a given serial number. "=CONCATENATE(LEFT(B2,12)&".pdf")"
Col D - has another CONCATENATE to help to define the new name of the PDF. "=CONCATENATE(A2&"-"&LEFT(B2,12)&".pdf")"
An example of what I am talking about...
"DMPQ44VZF4YD.pdf" gets renamed to "45872-DMPQ44VZF4YD.pdf"
I've recored a macro to record my using the CONCATENATE functions in cols C and D, then using autofill to drag that down manually to the bottom of the spreadsheet, then copying and pasting those (by value) to columns E and F and then deleting the columns A - D (inclusive) to leave behind only what I want. A messy way of doing things but it gets the job done.
Each Excel file can have a differing number of records/rows. I've arbitrarily set it to 1500 items in the VBA script. Please take a look...
Sub Macro1()
Macro1 Macro
Range("C2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(LEFT(RC[-1],12)&"".pdf"")"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C1500"), Type:=xlFillDefault
Range("C2:C174").Select
Range("D179").Select
ActiveWindow.SmallScroll Down:=-364
Range("D2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3]&""-""&LEFT(RC[-2],12)&"".pdf"")"
Range("D2").Select
Selection.AutoFill Destination:=Range("D2:D1500"), Type:=xlFillDefault
Range("D2:D174").Select
ActiveWindow.SmallScroll ToRight:=-2
ActiveWindow.SmallScroll Down:=-528
Columns("C:D").Select
Selection.Copy
Columns("F:F").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("A:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("D5").Select
Dim Rng As Range
For Each Rng In ActiveSheet.UsedRange
If Rng.Value2 = ".pdf" Or Rng.Value2 = "-.pdf" Then Rng.ClearContents
Next Rng
End Sub
It works well but can take a while to process (due to the arbitrarily high number of possible records in a given sheet, perhaps as well as the 'for' loop at the end to get rid of any trailing ".pdfs" and "-.pdfs" that are a hangover from otherwise empty cells affected by the CONCATENATE function). Is there any way of making the more efficient when dealign with a small number of records or perhaps making it easily more scalable?
Here is a link to the code if that helps.
Thanks once again.
Will

Answer 1

You may give this a try...
Sub RenamePDFFiles()
Dim lr As Long
lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With Application
.Calculation = xlCalculationManual
.EnableAutoComplete = False
.ScreenUpdating = False
End With
Range("C2:C" & lr).Formula = "=IF(B2="""","""",LEFT(B2,12)&"".pdf"")"
Range("C2:C" & lr).Value = Range("C2:C" & lr).Value
Range("D2:D" & lr).Formula = "=IF(AND(A2="""",B2=""""),"""",A2&""-""&LEFT(B2,12)&"".pdf"")"
Range("D2:D" & lr).Value = Range("D2:D" & lr).Value
Columns("A:B").Delete
With Application
.Calculation = xlCalculationAutomatic
.EnableAutoComplete = True
.ScreenUpdating = True
End With
End Sub
For formula in column D, I have used AND function for the logical test so that if both columns A and B are empty, the corresponding cell in column D will also be empty. If required, change it to OR condition.