StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
text
Body
copied!<p>After modifying the code provided by Siddharth, this is the final code that worked for me. The save feature needed to also remove a format and the Formula to search and add the filename to the cells did not work without this edit. I also had to change the sheet to the activeSheet, because it was constantly changing. Here is the code:</p> <pre><code>Sub Naming() Dim LR As Long, i As Long, lngCol As Long lngCol = Rows(1).Find("NAME", lookat:=xlWhole).Column 'assumes there will always be a column with "NAME" in row 1 Application.ScreenUpdating = False LR = Cells(Rows.Count, lngCol).End(xlUp).Row For i = LR To 1 Step -1 If Len(Cells(i, lngCol).Value) < 4 Then Rows(i).Delete Next i Application.ScreenUpdating = True ' Insert Column after NAME and then rename it NAME+TYPE Dim ws As Worksheet Dim lRow As Long, aCol As Long Dim aCell As Range Set ws = ActiveSheet 'Need to change to the Active sheet With ws Set aCell = .Rows(1).Find("NAME") ' Check if the column with "NAME" is found, it is assumed earlier If Not aCell Is Nothing Then aCol = aCell.Column .Columns(aCol + 1).EntireColumn.Insert .Cells(1, aCol + 1).Value = "NAME+TYPE" .Activate ' Freeze the Top Row Rows("1:1").Select With ActiveWindow .SplitColumn = 0 .SplitRow = 1 End With ActiveWindow.FreezePanes = True ' Get lastrow of Col which has "NAME" lRow = .Range(Split(.Cells(, aCol).Address, "$")(1) & .Rows.Count).End(xlUp).Row 'Save the file and format the filetype Dim wkb As Workbook Set wkb = ActiveWorkbook 'change to your workbook reference wkb.SaveAs Replace(wkb.Name, "#csv.gz", ""), 52 'change "csv.gz" to ".xlsm" if need be ' Add the formula to all the cells in 1 go. .Range(Split(.Cells(, aCol + 1).Address, "$")(1) & "2:" & _ Split(.Cells(, aCol + 1).Address, "$")(1) & lRow).Formula = _ "=LEFT(MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1),5)&RC[-1]" .Columns("A:AK").Columns.AutoFit Else MsgBox "NAME Column Not Found" End If End With ' Change the Range of the cursor Range("A1").Select Application.CutCopyMode = False End Sub </code></pre>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload