Inserting certain data 1

[scottie1]

Hi

I have hundreds of spreadsheets saved but i need to open them and put in 1 copied cell of information then auto fill (I already have column A:A empty. The information to be inserted differs for each spreadsheet but information will always go in cell A1, then auto fill down the list. The information to be inserted is on another spreadsheet with the name of the file name next to each bit of cell info. Is there away I can perhaps open the spreadsheet with the info use a bit of VB code to look for the file, open it find cell B1 onthe info file and insert it autofill with the information thats in the cell and close. I need this to work on several spreadsheets at 1 time to save an awful lot of time.

 

[TonyJollans]

Hi scottie1,

I think this is what you want ..

[blue]For each c in Range("A1",Range("A65535").End(xlUp))
    Workbooks.Open c
    With Activeworkbook.activesheet.cells(1,1)
        .Formula = c.Offset(,1)
        .Autofill Range("A1",Range("B65535").End(xlUp).offset(0,-1))
    end with
    ActiveWorkbook.Close True
Next[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

 

[RobSchultz]

Try this...

Place this into a module...

Option Explicit

Public Sub BeginProcess()
    
    Dim oThisXLS As Excel.Worksheet: Set oThisXLS = Worksheets("Sheet1")
    Dim rowCount As Integer: rowCount = 0
    Dim filePath As String
    Dim newValue As String
    
    Do
        rowCount = rowCount + 1
        
        filePath = oThisXLS.Range("A" & rowCount).Value
        newValue = oThisXLS.Range("B" & rowCount).Value
        
        If filePath = "" Or newValue = "" Then
            Exit Do
        Else
            oThisXLS.Range("C" & rowCount).Value = FixFile(filePath, newValue)
        End If
    
    Loop
    
    Call MsgBox("Finished! Check spreadsheet for errors", vbOKOnly + vbInformation, "")

End Sub

Private Function FixFile(ByVal filePath As String, ByVal newValue As String) As String

    On Error GoTo errHandler
    
    If Dir$(filePath, vbNormal) = "" Then
        FixFile = "ERROR: File not found!"
        Exit Function
    End If

    Const cellLocation As String = "A1"
    Const sheetName As String = "Sheet1"
    
    Dim oOtherXLA As Excel.Application: Set oOtherXLA = New Excel.Application
    Dim oOtherXLW As Excel.Workbook
    Dim oOtherXLS As Excel.Worksheet
    
    With oOtherXLA
        .AskToUpdateLinks = False
        .Visible = False
        .EnableEvents = False
        Set oOtherXLW = oOtherXLA.Workbooks.Open(Filename:=filePath, UpdateLinks:=False, ReadOnly:=False, IgnoreReadOnlyRecommended:=True)
    End With
    
    Set oOtherXLS = oOtherXLW.Worksheets(sheetName)
    oOtherXLS.Range(cellLocation).Value = newValue
    oOtherXLW.Save
        
errExit:
    On Error Resume Next
    
    oOtherXLW.Close False
    oOtherXLA.Quit
    
    Set oOtherXLS = Nothing
    Set oOtherXLW = Nothing
    Set oOtherXLA = Nothing
    
    FixFile = "SUCCESS!"
    
    Exit Function
    
errHandler:

    FixFile = "ERROR: " & Err.Number & ":" & Replace(Err.Description, vbCrLf, "~")
    Resume errExit

End Function

In the same spreadsheet on "Sheet1" use column A for the full file path to each spreadsheet and column B for the new value. Column C will contain any errors that occur.

Once populated click in the BeginProcess procedure and hit "F5" to run.

You may need to change some constants in order for this to run ("Sheet1" in the FixFile procedure for example)

HtH,

Rob

-Focus on the solution to the problem, not the obstacles in the way.-

 

[scottie1]

Hi tony

I tried this code its picking up the reference but cant seem to find the file to open. Am I supposed to edit this code a bit. I'm getting a run time error 1004, 1300013039370.xls could not be found. This happens when I get to Workbooks.Open c

 

[TonyJollans]

Hi scottie1,

The code I posted assumes a complete path and file name in column A. If you don't have that you will need to adjust the code to include the bits which are not in the cell, perhaps ..

[blue]

Workbooks.Open ActiveWorkbook.Path & "\" & c

[/blue]

Enjoy,
Tony

--------------------------------------------------------------------------------------------
We want to help you; help us to do it by reading this: Before you ask a question.

 

[scottie1]

Tony/Rob

Cheers guys I'd ended up guessing what else I needed for Tonys code by seeing what Rob had written about putting the Path name in the cell as well.
So you've both been a fantastic help.


Cheers Scottie1