Insert a value into mutiple Excel files

Question

I want to read multiple Excel files and insert a value in any cell declared in the code.

This code inserts the data in the workbook:

Sub InsertValueInCell()
Range("C3").Value = _
  InputBox(Prompt:="Enter the value you want to insert.")
End Sub

I want the code to read multiple Excel files and after that I can insert a value in a specific cell for all those Excel files.

Answer 1

This should work for you:

Option Explicit 'Must be at very top of module, before any procedures.
                'Possibly the most important line in any code - forces you to declare your variables.

Public Sub AddValueToSheet()

    On Error GoTo ERROR_HANDLER

    'The Sheet to changed.
    Dim SheetName As String
    SheetName = "Sheet1"

    'Get a collection of files within the folder.
    Dim FileCollection As Collection
    Set FileCollection = New Collection
    Set FileCollection = EnumerateFiles("<folder path>\") 'Don't forget the final backslash.
    
    Dim ValueToEnter As String 'or whatever type you're trying to enter.
    ValueToEnter = InputBox("Enter the value you want to insert")
    
    'Look at each item in the collection.
    Dim wrkBkPath As Variant
    For Each wrkBkPath In FileCollection
    
        'Open the workbook.
        Dim wrkBk As Workbook
        Set wrkBk = Workbooks.Open(wrkBkPath)
        
        'Check if the sheet exists.
        'Add the value if it does, add the file name to the MissingSheetList string if it doesn't.
        Dim MissingSheetList As String
        If SheetExists(wrkBk, SheetName) Then
            wrkBk.Worksheets(SheetName).Range("A1") = ValueToEnter
        Else
            MissingSheetList = MissingSheetList & wrkBk.Name & vbCrLf
        End If
        
        'Save and close.
        wrkBk.Close SaveChanges:=True
    Next wrkBkPath
    
    'Display missing sheet list message if there's any.
    If MissingSheetList <> "" Then
        MsgBox "The files were missing " & SheetName & vbCr & vbCr & MissingSheetList, vbInformation + vbOKOnly
    End If
    
Exit Sub

'If an error occurs code skips to this section.
ERROR_HANDLER:
    Dim ErrMsg As String
    ErrMsg = "AddValueToSheet()" & vbCr & Err.Description
        
    'Add error handling code.
    Select Case Err.Number

        Case Else

    End Select
    
End Sub

'Check if a sheet exists by trying to set a reference to it.
Private Function SheetExists(wrkBk As Workbook, SheetName As String) As Boolean
    On Error Resume Next
        Dim ShtRef As Worksheet
        Set ShtRef = wrkBk.Worksheets(SheetName)
        SheetExists = (Err.Number = 0) 'Was an error returned?  True or False.
    On Error GoTo 0
End Function

'Returns all xls* files from the path supplied by sDirectory.
'Each file path is added to the FilePaths collection.
Private Function EnumerateFiles(ByVal sDirectory As String) As Collection

    On Error GoTo ERROR_HANDLER

    'You can remove StatusBar lines if you want - code might run too fast to see anyway.
    Application.StatusBar = "Collating files: " & sDirectory 'Update status bar.
    
    Dim cTemp As Collection
    Set cTemp = New Collection
    
    Dim sTemp As String
    sTemp = Dir$(sDirectory & "*.xls*")
    Do While Len(sTemp) > 0
        cTemp.Add sDirectory & sTemp
        sTemp = Dir$
    Loop
    
    Set EnumerateFiles = cTemp
    Application.StatusBar = False 'Reset status bar.
    
Exit Function

'If an error occurs code skips to this section.
ERROR_HANDLER:
    Dim ErrMsg As String
    ErrMsg = "EnumerateFiles()" & vbCr & Err.Description
        
    'Add error handling code.
    Select Case Err.Number

        Case Else

    End Select

End Function