Renaming files from a number string inside the file.

Hi...

Big problem here so any help appreciated.

I have 4000 files all randomly saved with any name you wish to name, all in
the same folder. The only thing the 4000 files have in common is that each
file contains a sheet called 'summary' and in cell D3 on that sheet there is
a number string sitting amongst random text eg:

Yellow Diggers 56673 Lincoln
Big Buses London 5566678 London Jan

I need code to extract the number from cell D3 and then to rename the file
with that number eg:

56673.xls
5566678.xls

Taking this further, I need a working example of this file as I don't have
the expertese or the time to glue code together. Whats more I'll send £20
through Paypal to the first helper who can provide me with working code in an
excel file to gacartwright@hotmail.com

Thanks...

Gordon.

Hi Gordon

I think I would first use this macro to get the file name and cell value on new worksheet

Sub Summary_cells_from_Different_Workbooks_1()
Dim FileNameXls As Variant
Dim SummWks As Worksheet
Dim ColNum As Integer
Dim myCell As Range, Rng As Range
Dim RwNum As Long, FNum As Long, FinalSlash As Long
Dim ShName As String, PathStr As String
Dim SheetCheck As String, JustFileName As String
Dim JustFolder As String

ShName = "summary" '<---- Change
Set Rng = Range("D3") '<---- Change

'Select the files with GetOpenFilename
FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
MultiSelect:=True)

If IsArray(FileNameXls) = False Then
'do nothing
Else
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

'Add a new workbook with one sheet for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)

'The links to the first workbook will start in row 2
RwNum = 1

For FNum = LBound(FileNameXls) To UBound(FileNameXls)
ColNum = 1
RwNum = RwNum + 1
FinalSlash = InStrRev(FileNameXls(FNum), "\")
JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)

'copy the workbook name in column A
SummWks.Cells(RwNum, 1).Value = FileNameXls

'build the formula string
PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!"

On Error Resume Next
SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
If Err.Number <> 0 Then
'If the sheet name not exist in the workbook the row color will be Yellow.
SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1).Interior.Color = vbYellow
Else
For Each myCell In Rng.Cells
ColNum = ColNum + 1
SummWks.Cells(RwNum, ColNum).Formula = "=" & PathStr & myCell.Address
Next myCell
End If
On Error GoTo 0
Next FNum

' Use AutoFit for setting the column width in the new workbook
SummWks.UsedRange.Columns.AutoFit

MsgBox "The Summary is ready, save the file if you want to keep it"

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End If
End Sub


Now create a formula to extract the info in a new column from each cell
When you done that make a loop that use the VBA Name function to rename the files

This is a start, post back if you need more help


--
Regards Ron De Bruin
http://www.rondebruin.nl



"Gordon" <Gordon@discussions.microsoft.com> wrote in message news:23B7B140-F5B2-4EBF-A96C-22C987517649@microsoft.com...
> Hi...
>
> Big problem here so any help appreciated.
>
> I have 4000 files all randomly saved with any name you wish to name, all in
> the same folder. The only thing the 4000 files have in common is that each
> file contains a sheet called 'summary' and in cell D3 on that sheet there is
> a number string sitting amongst random text eg:
>
> Yellow Diggers 56673 Lincoln
> Big Buses London 5566678 London Jan
>
> I need code to extract the number from cell D3 and then to rename the file
> with that number eg:
>
> 56673.xls
> 5566678.xls
>
> Taking this further, I need a working example of this file as I don't have
> the expertese or the time to glue code together. Whats more I'll send £20
> through Paypal to the first helper who can provide me with working code in an
> excel file to gacartwright@hotmail.com
>
> Thanks...
>
> Gordon.
>
>
>
>
>
>

Oops

> 'copy the workbook name in column A
> SummWks.Cells(RwNum, 1).Value = FileNameXls

Use
SummWks.Cells(RwNum, 1).Value = FileNameXls(FNum)


--
Regards Ron De Bruin
http://www.rondebruin.nl



"Ron de Bruin" <rondebruin@kabelfoon.nl> wrote in message news:%23CEDKd3lGHA.4700@TK2MSFTNGP02.phx.gbl...
> Hi Gordon
>
> I think I would first use this macro to get the file name and cell value on new worksheet
>
> Sub Summary_cells_from_Different_Workbooks_1()
> Dim FileNameXls As Variant
> Dim SummWks As Worksheet
> Dim ColNum As Integer
> Dim myCell As Range, Rng As Range
> Dim RwNum As Long, FNum As Long, FinalSlash As Long
> Dim ShName As String, PathStr As String
> Dim SheetCheck As String, JustFileName As String
> Dim JustFolder As String
>
> ShName = "summary" '<---- Change
> Set Rng = Range("D3") '<---- Change
>
> 'Select the files with GetOpenFilename
> FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
> MultiSelect:=True)
>
> If IsArray(FileNameXls) = False Then
> 'do nothing
> Else
> With Application
> .Calculation = xlCalculationManual
> .ScreenUpdating = False
> End With
>
> 'Add a new workbook with one sheet for the Summary
> Set SummWks = Workbooks.Add(1).Worksheets(1)
>
> 'The links to the first workbook will start in row 2
> RwNum = 1
>
> For FNum = LBound(FileNameXls) To UBound(FileNameXls)
> ColNum = 1
> RwNum = RwNum + 1
> FinalSlash = InStrRev(FileNameXls(FNum), "\")
> JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
> JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)
>
> 'copy the workbook name in column A
> SummWks.Cells(RwNum, 1).Value = FileNameXls
>
> 'build the formula string
> PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!"
>
> On Error Resume Next
> SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
> If Err.Number <> 0 Then
> 'If the sheet name not exist in the workbook the row color will be Yellow.
> SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1).Interior.Color = vbYellow
> Else
> For Each myCell In Rng.Cells
> ColNum = ColNum + 1
> SummWks.Cells(RwNum, ColNum).Formula = "=" & PathStr & myCell.Address
> Next myCell
> End If
> On Error GoTo 0
> Next FNum
>
> ' Use AutoFit for setting the column width in the new workbook
> SummWks.UsedRange.Columns.AutoFit
>
> MsgBox "The Summary is ready, save the file if you want to keep it"
>
> With Application
> .Calculation = xlCalculationAutomatic
> .ScreenUpdating = True
> End With
> End If
> End Sub
>
>
> Now create a formula to extract the info in a new column from each cell
> When you done that make a loop that use the VBA Name function to rename the files
>
> This is a start, post back if you need more help
>
>
> --
> Regards Ron De Bruin
> http://www.rondebruin.nl
>
>
>
> "Gordon" <Gordon@discussions.microsoft.com> wrote in message news:23B7B140-F5B2-4EBF-A96C-22C987517649@microsoft.com...
>> Hi...
>>
>> Big problem here so any help appreciated.
>>
>> I have 4000 files all randomly saved with any name you wish to name, all in
>> the same folder. The only thing the 4000 files have in common is that each
>> file contains a sheet called 'summary' and in cell D3 on that sheet there is
>> a number string sitting amongst random text eg:
>>
>> Yellow Diggers 56673 Lincoln
>> Big Buses London 5566678 London Jan
>>
>> I need code to extract the number from cell D3 and then to rename the file
>> with that number eg:
>>
>> 56673.xls
>> 5566678.xls
>>
>> Taking this further, I need a working example of this file as I don't have
>> the expertese or the time to glue code together. Whats more I'll send £20
>> through Paypal to the first helper who can provide me with working code in an
>> excel file to gacartwright@hotmail.com
>>
>> Thanks...
>>
>> Gordon.
>>
>>
>>
>>
>>
>>
>
>

Ron...

How would you do this?

Now create a formula to extract the info in a new column from each cell
When you done that make a loop that use the VBA Name function to rename the
files

Thanks

Gordon.

"Ron de Bruin" wrote:

> Hi Gordon
>
> I think I would first use this macro to get the file name and cell value on new worksheet
>
> Sub Summary_cells_from_Different_Workbooks_1()
> Dim FileNameXls As Variant
> Dim SummWks As Worksheet
> Dim ColNum As Integer
> Dim myCell As Range, Rng As Range
> Dim RwNum As Long, FNum As Long, FinalSlash As Long
> Dim ShName As String, PathStr As String
> Dim SheetCheck As String, JustFileName As String
> Dim JustFolder As String
>
> ShName = "summary" '<---- Change
> Set Rng = Range("D3") '<---- Change
>
> 'Select the files with GetOpenFilename
> FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
> MultiSelect:=True)
>
> If IsArray(FileNameXls) = False Then
> 'do nothing
> Else
> With Application
> .Calculation = xlCalculationManual
> .ScreenUpdating = False
> End With
>
> 'Add a new workbook with one sheet for the Summary
> Set SummWks = Workbooks.Add(1).Worksheets(1)
>
> 'The links to the first workbook will start in row 2
> RwNum = 1
>
> For FNum = LBound(FileNameXls) To UBound(FileNameXls)
> ColNum = 1
> RwNum = RwNum + 1
> FinalSlash = InStrRev(FileNameXls(FNum), "\")
> JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
> JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)
>
> 'copy the workbook name in column A
> SummWks.Cells(RwNum, 1).Value = FileNameXls
>
> 'build the formula string
> PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!"
>
> On Error Resume Next
> SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
> If Err.Number <> 0 Then
> 'If the sheet name not exist in the workbook the row color will be Yellow.
> SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1).Interior.Color = vbYellow
> Else
> For Each myCell In Rng.Cells
> ColNum = ColNum + 1
> SummWks.Cells(RwNum, ColNum).Formula = "=" & PathStr & myCell.Address
> Next myCell
> End If
> On Error GoTo 0
> Next FNum
>
> ' Use AutoFit for setting the column width in the new workbook
> SummWks.UsedRange.Columns.AutoFit
>
> MsgBox "The Summary is ready, save the file if you want to keep it"
>
> With Application
> .Calculation = xlCalculationAutomatic
> .ScreenUpdating = True
> End With
> End If
> End Sub
>
>
> Now create a formula to extract the info in a new column from each cell
> When you done that make a loop that use the VBA Name function to rename the files
>
> This is a start, post back if you need more help
>
>
> --
> Regards Ron De Bruin
> http://www.rondebruin.nl
>
>
>
> "Gordon" <Gordon@discussions.microsoft.com> wrote in message news:23B7B140-F5B2-4EBF-A96C-22C987517649@microsoft.com...
> > Hi...
> >
> > Big problem here so any help appreciated.
> >
> > I have 4000 files all randomly saved with any name you wish to name, all in
> > the same folder. The only thing the 4000 files have in common is that each
> > file contains a sheet called 'summary' and in cell D3 on that sheet there is
> > a number string sitting amongst random text eg:
> >
> > Yellow Diggers 56673 Lincoln
> > Big Buses London 5566678 London Jan
> >
> > I need code to extract the number from cell D3 and then to rename the file
> > with that number eg:
> >
> > 56673.xls
> > 5566678.xls
> >
> > Taking this further, I need a working example of this file as I don't have
> > the expertese or the time to glue code together. Whats more I'll send £20
> > through Paypal to the first helper who can provide me with working code in an
> > excel file to gacartwright@hotmail.com
> >
> > Thanks...
> >
> > Gordon.
> >
> >
> >
> >
> >
> >
>
>
>

Answer my question in your other thread and I send you a test macro

--
Regards Ron De Bruin
http://www.rondebruin.nl



"Gordon" <Gordon@discussions.microsoft.com> wrote in message news:AF13AFC2-9CC0-47B6-A1A7-83F69A5C3342@microsoft.com...
> Ron...
>
> How would you do this?
>
> Now create a formula to extract the info in a new column from each cell
> When you done that make a loop that use the VBA Name function to rename the
> files
>
> Thanks
>
> Gordon.
>
> "Ron de Bruin" wrote:
>
>> Hi Gordon
>>
>> I think I would first use this macro to get the file name and cell value on new worksheet
>>
>> Sub Summary_cells_from_Different_Workbooks_1()
>> Dim FileNameXls As Variant
>> Dim SummWks As Worksheet
>> Dim ColNum As Integer
>> Dim myCell As Range, Rng As Range
>> Dim RwNum As Long, FNum As Long, FinalSlash As Long
>> Dim ShName As String, PathStr As String
>> Dim SheetCheck As String, JustFileName As String
>> Dim JustFolder As String
>>
>> ShName = "summary" '<---- Change
>> Set Rng = Range("D3") '<---- Change
>>
>> 'Select the files with GetOpenFilename
>> FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xls", _
>> MultiSelect:=True)
>>
>> If IsArray(FileNameXls) = False Then
>> 'do nothing
>> Else
>> With Application
>> .Calculation = xlCalculationManual
>> .ScreenUpdating = False
>> End With
>>
>> 'Add a new workbook with one sheet for the Summary
>> Set SummWks = Workbooks.Add(1).Worksheets(1)
>>
>> 'The links to the first workbook will start in row 2
>> RwNum = 1
>>
>> For FNum = LBound(FileNameXls) To UBound(FileNameXls)
>> ColNum = 1
>> RwNum = RwNum + 1
>> FinalSlash = InStrRev(FileNameXls(FNum), "\")
>> JustFileName = Mid(FileNameXls(FNum), FinalSlash + 1)
>> JustFolder = Left(FileNameXls(FNum), FinalSlash - 1)
>>
>> 'copy the workbook name in column A
>> SummWks.Cells(RwNum, 1).Value = FileNameXls
>>
>> 'build the formula string
>> PathStr = "'" & JustFolder & "\[" & JustFileName & "]" & ShName & "'!"
>>
>> On Error Resume Next
>> SheetCheck = ExecuteExcel4Macro(PathStr & Range("A1").Address(, , xlR1C1))
>> If Err.Number <> 0 Then
>> 'If the sheet name not exist in the workbook the row color will be Yellow.
>> SummWks.Cells(RwNum, 1).Resize(1, Rng.Cells.Count + 1).Interior.Color = vbYellow
>> Else
>> For Each myCell In Rng.Cells
>> ColNum = ColNum + 1
>> SummWks.Cells(RwNum, ColNum).Formula = "=" & PathStr & myCell.Address
>> Next myCell
>> End If
>> On Error GoTo 0
>> Next FNum
>>
>> ' Use AutoFit for setting the column width in the new workbook
>> SummWks.UsedRange.Columns.AutoFit
>>
>> MsgBox "The Summary is ready, save the file if you want to keep it"
>>
>> With Application
>> .Calculation = xlCalculationAutomatic
>> .ScreenUpdating = True
>> End With
>> End If
>> End Sub
>>
>>
>> Now create a formula to extract the info in a new column from each cell
>> When you done that make a loop that use the VBA Name function to rename the files
>>
>> This is a start, post back if you need more help
>>
>>
>> --
>> Regards Ron De Bruin
>> http://www.rondebruin.nl
>>
>>
>>
>> "Gordon" <Gordon@discussions.microsoft.com> wrote in message news:23B7B140-F5B2-4EBF-A96C-22C987517649@microsoft.com...
>> > Hi...
>> >
>> > Big problem here so any help appreciated.
>> >
>> > I have 4000 files all randomly saved with any name you wish to name, all in
>> > the same folder. The only thing the 4000 files have in common is that each
>> > file contains a sheet called 'summary' and in cell D3 on that sheet there is
>> > a number string sitting amongst random text eg:
>> >
>> > Yellow Diggers 56673 Lincoln
>> > Big Buses London 5566678 London Jan
>> >
>> > I need code to extract the number from cell D3 and then to rename the file
>> > with that number eg:
>> >
>> > 56673.xls
>> > 5566678.xls
>> >
>> > Taking this further, I need a working example of this file as I don't have
>> > the expertese or the time to glue code together. Whats more I'll send £20
>> > through Paypal to the first helper who can provide me with working code in an
>> > excel file to gacartwright@hotmail.com
>> >
>> > Thanks...
>> >
>> > Gordon.
>> >
>> >
>> >
>> >
>> >
>> >
>>
>>
>>