Insert new column and paste (Shortened) workbook name down to last cell

Manerlao

New Member
Joined
Apr 14, 2020
Messages
34
Office Version
2019
Platform
Windows
Hi all!

I have a problem which is really troubling me! If someone could please help, I would really appreciate it!

Overview:

I have a range of different workbooks which I need to insert a new column to and include a specific ID which is based on the specific workbook name.3

Objective:

- Insert new column in B:B with name ID_Name in B1 (I have this code already)
- Paste the name of the workbook from cell B2:Last cell in that column (But I want to paste a shortened name of the workbook). (The challenge for me)

My workbooks all have the name structure: ABCD_File_Date_Version or ABCDE_File_Date_Version or ABCDEF_File_Date_Version
So I just want to paste everything before the underscore '_' for that specific workbook when I run the macro.
i.e. I just need ABCD or ABCDE or ABCDEF depending on the file.

My code is in my personal macro workbook, and it works very well so far, but I can't get it to paste the name of the workbook according to my requirement.

Here is my code so far:

VBA Code:
Sub AddCol()
'Add a new column in B:B with ID_Name

Dim ws As Worksheet
Dim lastRow As Long

lastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

If Range("B1") = "ID_Name" Then
Else
For Each ws In ActiveWorkbook.Sheets

ws.Range("B:B").EntireColumn.Insert
ws.Range("B1").Value = "ID_Name"

With ws
.Range(Cells(1, 2), Cells(lastRow, 1)).Value = ActiveWorkbook.Name
End With

    With ThisWorkbook.Worksheets
        ws.Range("B:B").NumberFormat = "Text"
    End With

Next ws
End If
        
End Sub

If anyone has some ideas, please let me know.

Thank you Excel Community!
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Manerlao

New Member
Joined
Apr 14, 2020
Messages
34
Office Version
2019
Platform
Windows
[UPDATE]
Hi all, just an update to my code!

This works really well to:
Insert new column
Paste workbook name

VBA Code:
Sub AddColTEST()
'Add a new column in B:B with ID_Name

Dim ws As Worksheet
Dim Formulas(1) As Variant
Dim lastRow As Long

If Range("B1") = "ID_Name" Then
'Nothing

Else
For Each ws In ActiveWorkbook.Sheets
ws.Activate

With ws
lastRow = .Cells(Rows.Count, 2).End(xlUp).Row

.Range("B:B").EntireColumn.Insert
.Range("B1").Value = "ID_Name"
.Range(Cells(2, 2), Cells(lastRow, 2)).Value = ActiveWorkbook.Name

End With

Next ws
End If
        
End Sub
but now I need to figure out how to paste a shortened name of the workbook.name.

Any ideas? thank you all!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,915
Office Version
365
Platform
Windows
How about
VBA Code:
Sub Manerlao()
   Dim Ws As Worksheet
   Dim WbkName As String
   
   If Range("B1") <> "ID_Name" Then
      WbkName = Split(ActiveWorkbook.Name, "_")(0)
      For Each ws In ActiveWorkbook.Worksheets
         ws.Range("B:B").EntireColumn.Insert
         ws.Range("B1").Value = "ID_Name"
         ws.Range("B2:B" & ws.Range("A" & Rows.Count).End(xlUp).Row).Value = WbkName
         ws.Range("B:B").NumberFormat = "Text"
      Next ws
   End If
End Sub
 

Manerlao

New Member
Joined
Apr 14, 2020
Messages
34
Office Version
2019
Platform
Windows
Hi again Fluff! I hope you have been well.

Thank you so much, that worked a real charm!

Also, I just realized I can also write ..... Left(ActiveWorkbook.Name, 4)
But my code isn't as clean and dynamic as the one you have kindly written! Even my name is in the Sub :D


Thanks you so much again!

Best regards,
M.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,915
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,099,507
Messages
5,469,029
Members
406,628
Latest member
jared92

This Week's Hot Topics

Top