How to optimise my CONCATENATE vba script in 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

If the code works and you are looking for optimization then this question belongs on https://codereview.stackexchange.com/ If it does not work, then please indicated the error and on which line it throws the error. — Scott Craner, Sep 20 '17 at 22:20
FWIW - the call of `CONCATENATE` in `=CONCATENATE(LEFT(B2,12)&".pdf")` is unnecessary - you are only passing it a single parameter so there is nothing to actually concatenate. Likewise with `=CONCATENATE(A2&"-"&LEFT(B2,12)&".pdf")`. The first one could just be `=LEFT(B2,12)&".pdf"` and the second one `=A2&"-"&LEFT(B2,12)&".pdf"`. — YowE3K, Sep 20 '17 at 22:28
[Don't use `.Activate`/`.Select`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba)! — BruceWayne, Sep 20 '17 at 23:05
Create a UDF which takes 2 range inputs for Cols A, B. Then use this UDF in your worksheet without wasting columns. The UDF will do equalivent of those formulas with less fuss. Alternatively use the Sub to generate final file name via loop (manually invoked). — PatricK, Sep 21 '17 at 00:15

score 1 · Accepted Answer · answered Sep 21 '17 at 06:50

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.

HI Sktneer, that really is incredible. An operation that was at at least 20 seconds of hoping and praying Excel would not crash on itself is over in a blink of an eye. Tried it for 2000 records and still deathly quick. Thanks so much. — William Lombard, Sep 21 '17 at 19:56
@WilliamLombard You're welcome! Glad it worked for you. Please take a minute to accept the solution to mark your question as Solved. — Subodh Tiwari sktneer, Sep 22 '17 at 03:57

How to optimise my CONCATENATE vba script in Excel?

1 Answers1