Re: Renaming Files

Name cell.Value As "C:\data" & cell.Offset(0, 2).Value & ".xls"

Add the \ after the folder name

"C:\data\"



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



"Gordon" <Gordon@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:707588B1-393B-4EBF-861F-78E0ADDCD83A@xxxxxxxxxxxxxxxx
Ron...

I get a run time error 53 File not found when I run this macro from a
module. The line below is highlighted in yellow. I placed an empty folder at
c:\data in response to this message but no change. Same error message. I'm
running excel 2003 on windows 2000 of this makes any difference.

Line that highlights in yellow...

Name cell.Value As "C:\data" & cell.Offset(0, 2).Value & ".xls"

I sense we are very close here...probably me being dumb.

What next?

Gordon


"Ron de Bruin" wrote:

Hi Gordon

I take it the second test would be to save the file with the acquired number?

Ok, with the *** with the file names and numbers active run this macro to rename the files
It move the files to "C:\" now but you can change that to a folder like this "C:\Data\"

Sub test()
For Each cell In Columns("A").SpecialCells(xlCellTypeConstants)
Name cell.Value As "C:\" & cell.Offset(0, 2).Value & ".xls"
Next cell
End Sub


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



"Gordon" <Gordon@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:9C3C1E98-C662-4AE9-B2FE-FD65E95D5C74@xxxxxxxxxxxxxxxx
Hi Ron...

Yep...just cross referenced 20 entries and all correct. The right number is
falling to the C column.

I take it the second test would be to save the file with the acquired number?

Thanks...this is very impressive stuff.

I await your next post.

Gordon.

"Ron de Bruin" wrote:

Hi Gordon

First test
Open a new workbook and copy this macro in a normal module
After you run it the file names you have select are in A the value of B is the D3 value and in C the number if it is correct
????

Do you see the number in C ?


Sub Summary_cells_from_Different_Workbooks_1()
Dim FileNameXls As Variant
Dim SummWks As Work***
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 *** for the Summary
Set SummWks = Workbooks.Add(1).Worksheets(1)

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

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(FNum)

'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 *** 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
SummWks.UsedRange.Value = SummWks.UsedRange.Value

SummWks.UsedRange.Columns("B:B").TextToColumns Destination:=Columns("E:E"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, _
TrailingMinusNumbers:=True
SummWks.UsedRange.Columns("C").Formula = "=sum(E1:IV1)"

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

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



"Gordon" <Gordon@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:F246DF88-6AA9-40CA-9EA1-BD9E1DFB4071@xxxxxxxxxxxxxxxx
Hi Ron...

Yes, there is always a random number (random length) amongst random text in
D3 in all 4000 files.

Thanks for sticking with this.

Gordon.

"Ron de Bruin" wrote:

Stay in the same thread please

Yellow Diggers 56673 Lincoln
Big Buses London 5566678 London Jan

Is there always one number in the value of D3 of each file ?
Answer this and I set up a testing macro for you



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



"Gordon" <Gordon@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:BCB4E3D1-AC49-4FA8-93C4-76E98E7ED276@xxxxxxxxxxxxxxxx
Still looking for the start to finish solution. I'm not a pro at this and
fragmnents of code that needs linking together is beyond my expertese...

Thanks anyway.

Gordon.

"Ron de Bruin" wrote:

See your other thread

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



"Gordon" <Gordon@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message news:B907D777-CB74-401E-9246-B51158A9C9A5@xxxxxxxxxxxxxxxx
Hi...

Can anyone help me out here...initial help has been patchy. I'm beginning to
think this is impossible...

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

Yellow Diggers 56673 Lincoln
Big Buses London 5566678 London Jan

I need code to open each file, extract the number from cell D3 and then to
rename the file with the extracted number. I need to do this for all files in
the folder. eg:

56673.xls
5566678.xls

Basically I need the code all linked to a macro button that will intiate the
entire process?

Big ask and I'm desperate. Thanks in advance.

Gordonn
















.

Loading