Macro - 360 spreadsheets add column on left of each and give a consecutive number

[canek9]

Hi, I have 360 spreadsheets all of them with 2 rows (Heading and data) and 80 columns. All of the spreadsheets have different names.

What I am trying to do is to insert a column in column A give a name (User ID) and add a consecutive number to each of them i.e. ID1, ID2, etc.

I can open one by one, insert the column, add the heading and insert the id (ID1, ID2, etc), but I don't want to do it for each of all of them.

Any easy way to do it?

Thanks

Canek9

 

[mrshl9898]

Hi, try:

Sub loop_through_all_worksheets()


Dim ws As Worksheet
Dim idcount As Long


For Each ws In ThisWorkbook.Worksheets
    ws.Activate
    Columns("A:A").Insert Shift:=xlToRight
    Range("A1").Value = "User ID"
    idcount = 1
        For i = 2 To ws.Columns(2).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Cells(i, 1).Value = "ID" & idcount
        idcount = idcount + 1
        Next i
Next


End Sub

 

[canek9]

Hi, thanks for the macro.

Apologies that I didn't expain myself properly.

I have 360 separated workbooks, each has just 1 tab with 2 rows each (1 with the header and 2 with the data) and I want to do the following
1. Insert a column A:A
2. Add the following text in A1:"ID"
3. On each separated workbook(spreadsheet) add a cosecutive number startin in ID1, ID2, etc.

Thanks for your help

 

[Norie]

Where are the 360 workbooks located?

Is the ID for each workbook based on anything, e.g. workbook name, or is it fine if it's sequential and unique?

 

[canek9]

workbooks located in the same folder.

I just need an unique ID for each one of them.

Thank

 

[Norie]

Try this.

Sub AddIDsToWBs()
Dim wb As Workbook
Dim FSO As Object
Dim fld As Object
Dim fl As Object
Dim strFolder As String
Dim cnt As Long

    strFolder = GetFolder()

    If strFolder = "" Then Exit Sub

    Set FSO = CreateObject("Scripting.FileSystemObject")

    Set fld = FSO.GetFolder(strFolder)

    For Each fl In fld.Files
        Set wb = Workbooks.Open(fl.Path)
        cnt = cnt + 1
        With wb.Sheets(1)
            .Columns(1).Insert
            .Range("A1").Value = "ID"
            .Range("A2").Value = "ID" & cnt
        End With

        wb.Close SaveChanges:=True
    Next fl

End Sub

Public Function GetFolder(Optional OpenAt As String) As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = OpenAt
        .Show
        If .SelectedItems.Count <> 0 Then
            GetFolder = .SelectedItems(1)
        End If
        
    End With
    
End Function

 

[canek9]

Apologies for my ignorance, where is the folder path?

My folder is located in (example: P:\Folder1\Folder2\Folder3\Folder4\Folder5\360 workbooks

Thanks

 

[Norie]

The code should prompt you to select the folder with the files, that's the purpose of the function GetFolder.

If you want to hard-code the path then replace GetFolder() with the path here:

    strFolder = GetFolder()

 

[canek9]

Thank you very much, I will try it.