File name to Cell

[Ranjith Kurian]

Hi

I have used the below code to open each workbook and format , now is it
possible to add a macro code so that it should add the workbook file name to
cell A2

example: if the file name is AU.xls then in same file in Cell A1 the name
should come as Austrila, and if the file name is BU.xls then in same file
Cell A1 the name should come as Burma etc..


Sub test()
Dim intTemp As Integer
Dim arrWorkBook As Variant
arrWorkBook = Array("AU.xls", "BU.xls", "DU.xls", "EF.xls")
For intTemp = 0 To UBound(arrWorkBook)
Workbooks.Open Filename:="C:\N\" & arrWorkBook(intTemp)
Rows("1:1").Select
With Selection.Interior
..ColorIndex = 6
..Pattern = xlSolid
End With
Next
End Sub

 

[Bob Phillips]

Sub test()
Dim intTemp As Integer
Dim arrWorkBook As Variant
arrWorkBook = Array("AU.xls", "BU.xls", "DU.xls", "EF.xls")
For intTemp = 0 To UBound(arrWorkBook)

Workbooks.Open Filename:="C:\N\" & arrWorkBook(intTemp)
With Rows("1:1").Interior
.ColorIndex = 6
.Pattern = xlSolid
End With

Select Case Left$(activeworkbokk.Name, 2)

Case "AU": Cells(intTemp + 1, "A").Value = "Australia"
Case "BU": Cells(intTemp + 1, "A").Value = "Burma"
Case "DU": Cells(intTemp + 1, "A").Value = "Dubai"
Case "EF": Cells(intTemp + 1, "A").Value = "EF???"
End Select
Next
End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[Jacob Skaria]

Try this untested code...arrData contains the text to be assigned to each
workbook

Sub test()
Dim intTemp As Integer
Dim arrData
Dim arrWorkBook As Variant

arrWorkBook = Array("AU.xls", "BU.xls", "DU.xls", "EF.xls")
arrData = Array("Austria", "Burma", "Du", "Ef")
For intTemp = 0 To UBound(arrWorkBook)
Workbooks.Open Filename:="C:\N\" & arrWorkBook(intTemp)
Range("A1") = arrData(intTemp)
Rows("1:1").Select
With Selection.Interior
..ColorIndex = 6
..Pattern = xlSolid
End With
Next
End Sub

If this post helps click Yes

 

[Ranjith Kurian]

Hey thanks a lot.

One more help i need, Suppose any of these file (AU.xls", "BU.xls",
"DU.xls", "EF.xls,) are missing it should pop a msg box stating this
particular file is missing if we click ok it should continue.

Is it possible to do..

 

[Jacob Skaria]

Dear Ranjith

Try this

Sub test()
Dim intTemp As Integer
Dim arrData As Variant
Dim arrWorkBook As Variant

arrWorkBook = Array("AU.xls", "BU.xls", "DU.xls", "EF.xls")
arrData = Array("Austria", "Burma", "Du", "Ef")
For intTemp = 0 To UBound(arrWorkBook)
If Dir("C:\N\" & arrWorkBook(intTemp)) <> "" Then
Workbooks.Open Filename:="C:\N\" & arrWorkBook(intTemp)
Range("A1") = arrData(intTemp)
Rows("1:1").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Else
MsgBox "File missing : " & arrWorkBook(intTemp)
End If
Next
End Sub


If this post helps click Yes

 

[Ranjith Kurian]

Thanks a lot very much.....

Dear Ranjith

Try this

Sub test()
Dim intTemp As Integer
Dim arrData As Variant
Dim arrWorkBook As Variant

arrWorkBook = Array("AU.xls", "BU.xls", "DU.xls", "EF.xls")
arrData = Array("Austria", "Burma", "Du", "Ef")
For intTemp = 0 To UBound(arrWorkBook)
If Dir("C:\N\" & arrWorkBook(intTemp)) <> "" Then
Workbooks.Open Filename:="C:\N\" & arrWorkBook(intTemp)
Range("A1") = arrData(intTemp)
Rows("1:1").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Else
MsgBox "File missing : " & arrWorkBook(intTemp)
End If
Next
End Sub


If this post helps click Yes