Adding the same header row to multiple spreadsheets

Question

Hello everyone

I have several data files (each in XLS format) that are the output of an experiment. Unfortunately, the files were created (in Matlab) without header rows, so it's hard to keep track of what each of the 10+ columns mean. I would therefore like to add a header row (the same header row) to each one of these spreadsheets, but I cannot figure out a way to do this automatically. I have hundreds of data files, and opening each one of them, pasting the header row and saving would take a lot of time.

Can anyone suggest a way to do this? Anticipated thanks for any replies!

Also, I really need to be able to do this quite soon, therefore apologies for cross-posting this on another Excel forum as well (will mark both as solved when they are)

Answer 1

Place all workbooks in a folder, without other workbooks.

Copy the following code into a module in another workbook (not in that folder) and modify/complete it.

When you run the macro, it will prompt the user to select a folder, then loop through the workbooks in the folder, and insert a header row.

---

Sub SetHeaderRow()

  Dim strPath As String

  Dim strFile As String

  Dim wbk As Workbook

  Dim wsh As Worksheet

  ' Let user select a folder

  With Application.FileDialog(msoFileDialogFolderPicker)

    If .Show Then

      strPath = .SelectedItems(1)

    Else

      MsgBox "No folder selected", vbInformation

      Exit Sub

    End If

  End With

  Application.ScreenUpdating = False

  If Right(strPath, 1) <> "" Then

    strPath = strPath & ""

  End If

  ' Loop through the Excel workbooks in the folder

  strFile = Dir(strPath & "*.xls*")

  Do While strFile <> ""

    ' Open the workbook

    Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)

    ' Loop through the worksheets in the workbook

    For Each wsh In wbk.Worksheets

      ' Insert row

      wsh.Range("A1").EntireRow.Insert

      ' Set some values

      wsh.Range("A1") = "This"

      wsh.Range("B1") = "That"

      ' ...

      wsh.Range("L1") = "Finally"

    Next wsh

    ' Save and close the workbook

    wbk.Close SaveChanges:=True

    ' On to the next

    strFile = Dir

  Loop

  Application.ScreenUpdating = True

End Sub

Answer 2

Thanks Hans!! Two questions:

• Does the code also do the Find&Replace operation that I mentioned? Essentially I just need to replace all occurences of "88" with "L" and of "99" with "R"
• I noticed that the files are converted to XLSX simply by changing the extension - is that enough, do they not need also to be 'properly' converted?

Regarding my other thread (about defining new columns in one file and repeating those operations in all other files) - are you sure the references would be meesed up even if the structure of the files (number of rows/columns) is the same? Would it be possible for you to tell me the lines of macro code that would do a "hello world" kind of operation (e.g. adding two columns) on one file and then repeat it in all other files, so that I can then change it to suit the particular operations I need to do? Also please tell me where in the above code those lines would need to be.

Many thanks again, I really appreciate your help!

Answer 3

Try this version. If you have already added the headers, comment out the part that does that.

Sub SetHeaderRow()

  Dim strPath As String

  Dim strFile As String

  Dim wbk As Workbook

  Dim wsh As Worksheet

  ' Let user select a folder

  With Application.FileDialog(msoFileDialogFolderPicker)

    If .Show Then

      strPath = .SelectedItems(1)

    Else

      MsgBox "No folder selected", vbInformation

      Exit Sub

    End If

  End With

  Application.ScreenUpdating = False

  If Right(strPath, 1) <> "" Then

    strPath = strPath & ""

  End If

  ' Loop through the csv files in the folder

  strFile = Dir(strPath & "*.csv")

  Do While strFile <> ""

    ' Open the workbook

    Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)

    Set wsh = wbk.Worksheets(1)

    ' Insert row

    wsh.Range("A1").EntireRow.Insert

    ' Set some values

    wsh.Range("A1") = "orderOfTrials"

    wsh.Range("B1") = "nrOfDotsInN1"

    wsh.Range("C1") = "nrOfDotsInN2"

    wsh.Range("D1") = "side_n1"

    wsh.Range("E1") = "side_n2"

    wsh.Range("F1") = "radius_dot_n1"

    wsh.Range("G1") = "radius_dot_n2"

    wsh.Range("H1") = "answerCorrect"

    wsh.Range("I1") = "numberOfCorrectResponsesForThisTypeOfTrial"

    wsh.Range("J1") = "reactionTimes"

    ' Center the cells

    wsh.Cells.HorizontalAlignment = xlCenter

    ' Autofit the columns

    wsh.Columns.AutoFit

    ' Freeze panes

    wsh.Select

    wsh.Rows(2).Select

    ActiveWindow.FreezePanes = True

    wsh.Range("A1").Select

    ' Save as .xlsx

    wbk.SaveAs Filename:=strPath & Replace(strFile, ".csv", ".xlsx"), _

      FileFormat:=51 ' xlOpenXMLWorkbook

    ' Close

    wbk.Close

    ' On to the next

    strFile = Dir

  Loop

  Application.ScreenUpdating = True

End Sub

I removed the loop through the worksheets, since a .csv file contains only one sheet.

Answer 4

Oops, my bad - the extension of the files was actually CSV, not XLSX! The macro worked beautifully when I made the correction, but I realised that I also need to perform four extra operations for each file:

• to centre-allign the contents of all cells
• to set the widths of all columns such that the text does not overflow (the equivalent of double-clicking in between any two columns when all the sheet is selected, to auto-set the widths of all columns)
• to do a Find&Replace (I need to replace a numeric code with a letter, as Matlab wouldn't let me write non-numeric data to file)
• to freeze the top row (from Freeze Panes) so that it stays visible even when scrolling further down the sheet

In addition, once these operations have been performed, the file can no longer be saved in CSV format, and it needs to be converted to XLS/XLSX. Can all of that be done automatically?

Thanks again!

Answer 5

Hi Hans, many thanks for your reply! I created a new macro-enabled workbook, and created and then ran the following macro (essentially I just replaced the names of the cells in the header row, as you suggested):

Sub SetHeaderRow()

  Dim strPath As String

  Dim strFile As String

  Dim wbk As Workbook

  Dim wsh As Worksheet

  ' Let user select a folder

  With Application.FileDialog(msoFileDialogFolderPicker)

    If .Show Then

      strPath = .SelectedItems(1)

    Else

      MsgBox "No folder selected", vbInformation

      Exit Sub

    End If

  End With

  Application.ScreenUpdating = False

  If Right(strPath, 1) <> "" Then

    strPath = strPath & ""

  End If

  ' Loop through the Excel workbooks in the folder

  strFile = Dir(strPath & "*.xlsx*")

  Do While strFile <> ""

    ' Open the workbook

    Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)

    ' Loop through the worksheets in the workbook

    For Each wsh In wbk.Worksheets

      ' Insert row

      wsh.Range("A1").EntireRow.Insert

      ' Set some values

      wsh.Range("A1") = "orderOfTrials"

      wsh.Range("B1") = "nrOfDotsInN1"

      wsh.Range("C1") = "nrOfDotsInN2"

      wsh.Range("D1") = "side_n1"

      wsh.Range("E1") = "side_n2"

      wsh.Range("F1") = "radius_dot_n1"

      wsh.Range("G1") = "radius_dot_n2"

      wsh.Range("H1") = "answerCorrect"

      wsh.Range("I1") = "numberOfCorrectResponsesForThisTypeOfTrial"

      wsh.Range("J1") = "reactionTimes"

    Next wsh

    ' Save and close the workbook

    wbk.Close SaveChanges:=True

    ' On to the next

    strFile = Dir

  Loop

  Application.ScreenUpdating = True

End Sub

However, after prompting me to select the folder where the data files reside, the macro seems to do nothing else, and the data files remain unchanged, i.e. no header row has been added to them.