|
Renaming Files
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 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 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 |
Renaming Files
See your other thread
-- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... 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 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 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 |
Renaming Files
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" wrote in message ... 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 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 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 |
Renaming Files
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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
Here's my approach:
This assumes that the random number has the following consistencies: 1. The first number in the string is the start of your identifying number, and 2. Your number is followed by a space " ". I've tested this and it works pretty good. It's a bit slow though. I'll be watching for other suggestions. Regards, Jamie ---------- Sub FileNamer() Dim FilePath As String Dim FileName As String Dim aStart As Integer Dim DestPath As String Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'EDIT TO MATCH PATH THAT CONTAINS YOUR FILES FilePath$ = "C:\Desktop\test\" 'EDIT TO MATCH FOLDER TO HOLD YOUR NEW FILES (MUST BE DIFFERENT FROM SOURCE DIR DestPath$ = "C:\Desktop\DestTest\" If Dir(DestPath$, vbDirectory) = "" Then MkDir (DestPath$) FileName$ = Dir(FilePath$ & "*.xls") Do Until FileName$ = "" Workbooks.Open FilePath$ & FileName$, 0, 1 a$ = Workbooks(FileName$).Sheets("Summary").Range("D3") .Value For x = 1 To Len(a$) If IsNumeric(Mid(a$, x, 1)) = True Then aStart = x a$ = Right(a$, Len(a$) - aStart + 1) a$ = Trim(Left(a$, InStr(a$, " "))) GoTo NumFound End If Next NumFound: ActiveWorkbook.SaveAs DestPath$ & a$ & ".xls" ActiveWorkbook.Close 0 FileName$ = Dir Loop Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "done" End Sub Gordon wrote: 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 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 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 |
Renaming Files
Must go now but if the numbers are correct in column C then you can use this macro to
rename the files and move them to C:\ (change that to your folder) Be sure that the sheet with the filenames and numbers is active 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 "Ron de Bruin" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
Ron...
how does this code interface with the rest of it? Thanks Gordon. "Ron de Bruin" wrote: Must go now but if the numbers are correct in column C then you can use this macro to rename the files and move them to C:\ (change that to your folder) Be sure that the sheet with the filenames and numbers is active 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 "Ron de Bruin" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
Hi...
I getting a run time error 1004 saying that the file 'testtest 1.xls' could not be found on the following line... Workbooks.Open FilePath$ & FileName$, 0, 1 Any thoughts... Gordon. "jseven" wrote: Here's my approach: This assumes that the random number has the following consistencies: 1. The first number in the string is the start of your identifying number, and 2. Your number is followed by a space " ". I've tested this and it works pretty good. It's a bit slow though. I'll be watching for other suggestions. Regards, Jamie ---------- Sub FileNamer() Dim FilePath As String Dim FileName As String Dim aStart As Integer Dim DestPath As String Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'EDIT TO MATCH PATH THAT CONTAINS YOUR FILES FilePath$ = "C:\Desktop\test\" 'EDIT TO MATCH FOLDER TO HOLD YOUR NEW FILES (MUST BE DIFFERENT FROM SOURCE DIR DestPath$ = "C:\Desktop\DestTest\" If Dir(DestPath$, vbDirectory) = "" Then MkDir (DestPath$) FileName$ = Dir(FilePath$ & "*.xls") Do Until FileName$ = "" Workbooks.Open FilePath$ & FileName$, 0, 1 a$ = Workbooks(FileName$).Sheets("Summary").Range("D3") .Value For x = 1 To Len(a$) If IsNumeric(Mid(a$, x, 1)) = True Then aStart = x a$ = Right(a$, Len(a$) - aStart + 1) a$ = Trim(Left(a$, InStr(a$, " "))) GoTo NumFound End If Next NumFound: ActiveWorkbook.SaveAs DestPath$ & a$ & ".xls" ActiveWorkbook.Close 0 FileName$ = Dir Loop Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "done" End Sub Gordon wrote: 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 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 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 |
Renaming Files
Hi Gordon
I take it the second test would be to save the file with the acquired number? Ok, with the sheet 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" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
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 sheet 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" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
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" wrote in message ... 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 sheet 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" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
Same error message...line highlighted in Yellow
Name cell.Value As "C:\data\" & cell.Offset(0, 2).Value & ".xls" Does this work your end? Gordon "Ron de Bruin" wrote: 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" wrote in message ... 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 sheet 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" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
Hi Gordon
Can you send me the file with the file names/numbers private -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... Same error message...line highlighted in Yellow Name cell.Value As "C:\data\" & cell.Offset(0, 2).Value & ".xls" Does this work your end? Gordon "Ron de Bruin" wrote: 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" wrote in message ... 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 sheet 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" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
On its way to you...
"Ron de Bruin" wrote: Hi Gordon Can you send me the file with the file names/numbers private -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... Same error message...line highlighted in Yellow Name cell.Value As "C:\data\" & cell.Offset(0, 2).Value & ".xls" Does this work your end? Gordon "Ron de Bruin" wrote: 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" wrote in message ... 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 sheet 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" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
Hi Gordon
The problem is that you have duplicate numbers and files with no number in D3 What do you want to do with these files ? -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... On its way to you... "Ron de Bruin" wrote: Hi Gordon Can you send me the file with the file names/numbers private -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... Same error message...line highlighted in Yellow Name cell.Value As "C:\data\" & cell.Offset(0, 2).Value & ".xls" Does this work your end? Gordon "Ron de Bruin" wrote: 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" wrote in message ... 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 sheet 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" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
Hi Ron...
Duplicate numbers or files without numbers can be deleted if it allows the wider process to work. If it means after running the big macro that I have to weed out anomalies then I'm happy to do that before running the second macro. Is this what you suggest? Gordon. "Ron de Bruin" wrote: Hi Gordon The problem is that you have duplicate numbers and files with no number in D3 What do you want to do with these files ? -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... On its way to you... "Ron de Bruin" wrote: Hi Gordon Can you send me the file with the file names/numbers private -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... Same error message...line highlighted in Yellow Name cell.Value As "C:\data\" & cell.Offset(0, 2).Value & ".xls" Does this work your end? Gordon "Ron de Bruin" wrote: 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" wrote in message ... 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 sheet 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" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
You can't use the same file name for workbooks
Use on error in the code like this If it can not rename the file it not move it to C:\Data You can then decide what to do with those files that stay in the folder where you have select them with GetOpenFilename. Sub test() For Each cell In Columns("A").SpecialCells(xlCellTypeConstants) On Error Resume Next Name cell.Value As "C:\data\" & cell.Offset(0, 2).Value & ".xls" On Error GoTo 0 Next cell End Sub -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... Hi Ron... Duplicate numbers or files without numbers can be deleted if it allows the wider process to work. If it means after running the big macro that I have to weed out anomalies then I'm happy to do that before running the second macro. Is this what you suggest? Gordon. "Ron de Bruin" wrote: Hi Gordon The problem is that you have duplicate numbers and files with no number in D3 What do you want to do with these files ? -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... On its way to you... "Ron de Bruin" wrote: Hi Gordon Can you send me the file with the file names/numbers private -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... Same error message...line highlighted in Yellow Name cell.Value As "C:\data\" & cell.Offset(0, 2).Value & ".xls" Does this work your end? Gordon "Ron de Bruin" wrote: 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" wrote in message ... 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 sheet 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" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 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 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 |
Renaming Files
Ron...
That worked a treat. Have tested it several times and this is fine. Top job. You are more than worthy of MVP status! I can't imagine I'll ever trouble you with such a complex task again. Thanks Gordon. "Ron de Bruin" wrote: You can't use the same file name for workbooks Use on error in the code like this If it can not rename the file it not move it to C:\Data You can then decide what to do with those files that stay in the folder where you have select them with GetOpenFilename. Sub test() For Each cell In Columns("A").SpecialCells(xlCellTypeConstants) On Error Resume Next Name cell.Value As "C:\data\" & cell.Offset(0, 2).Value & ".xls" On Error GoTo 0 Next cell End Sub -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... Hi Ron... Duplicate numbers or files without numbers can be deleted if it allows the wider process to work. If it means after running the big macro that I have to weed out anomalies then I'm happy to do that before running the second macro. Is this what you suggest? Gordon. "Ron de Bruin" wrote: Hi Gordon The problem is that you have duplicate numbers and files with no number in D3 What do you want to do with these files ? -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... On its way to you... "Ron de Bruin" wrote: Hi Gordon Can you send me the file with the file names/numbers private -- Regards Ron De Bruin http://www.rondebruin.nl "Gordon" wrote in message ... Same error message...line highlighted in Yellow Name cell.Value As "C:\data\" & cell.Offset(0, 2).Value & ".xls" Does this work your end? Gordon "Ron de Bruin" wrote: 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" wrote in message ... 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 sheet 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" wrote in message ... 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 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 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 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 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" wrote in message ... 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" wrote in message ... 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" wrote in message ... 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 sheet called 'summary' and in cell D3 on that sheet there is a number string sitting amongst random text eg: |
| All times are GMT +1. The time now is 02:57 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com