unknownymous

Board Regular
Joined
Sep 19, 2017
Messages
249
Office Version
  1. 2016
Platform
  1. Windows
Hi Team,

I was looking for some codes in bulk renaming of filenames and found below a helpful one (see current codes). I have a separate macro that can generate the file names (refer to B14). However, for me to change the filename, I do it manually. Example: Replace "." with "_Math_0619" and look for the equivalent name for the account code.


x OldFileName (Cell B14)IIIIIINew NameAlgebra0619
0001.xlsxBen_Math_0619.xlsx
0002.txt
0003.xlsx
0004.doc

<tbody>
</tbody>

Current Codes:

Sub RenameFiles()


Dim MyPath As String


ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("Filelist").Offset(1, 0).Select
RowCounter = 0
Unchanged = 0
If ActiveCell.Value = "" Then
MsgBox "No files detected", vbInformation, "Rename files"
Exit Sub
End If
MyPath = Range("Path").Value
If MyPath = "" Then
Application.ScreenUpdating = True
MsgBox "No Path specified", vbInformation, "Rename files"
Exit Sub
End If
If Right(MyPath, 1) <> "" Then MyPath = MyPath & ""
On Error GoTo BadFile
Do
If ActiveCell.Offset(RowCounter, 0).Interior.ColorIndex <> RenamedColour Then
NextFile = MyPath & ActiveCell.Offset(RowCounter, 0)
ChangeTo = MyPath & ActiveCell.Offset(RowCounter, 4)
RowCounter = RowCounter + 1
If NextFile = ChangeTo Then
Range("B" & RowCounter + Range("Filelist").Row & ":F" & RowCounter + Range("Filelist").Row).Interior.ColorIndex = UnchangedColour
Range("E" & RowCounter + Range("Filelist").Row).Value = "U"
Unchanged = Unchanged + 1
Else
Name NextFile As ChangeTo
Range("B" & RowCounter + Range("Filelist").Row & ":F" & RowCounter + Range("Filelist").Row).Interior.ColorIndex = RenamedColour
Range("E" & RowCounter + Range("Filelist").Row).Value = "R"
End If
Else
RowCounter = RowCounter + 1
End If
Loop Until ActiveCell.Offset(RowCounter, 0).Value = ""
Application.ScreenUpdating = True
MsgBox RowCounter - Unchanged & " files renamed" & Chr(13) & Unchanged & " files unchanged", vbInformation, "Rename files"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True
Exit Sub
BadFile:
Range("B" & RowCounter + Range("Filelist").Row & ":F" & RowCounter + Range("Filelist").Row).Interior.ColorIndex = ProblemColour
Range("E" & RowCounter + Range("Filelist").Row).Value = "P"
Range("Filelist").Offset(RowCounter, 0).Select
Application.ScreenUpdating = True
MsgBox "Problem with file..." & Chr(13) & Chr(13) & NextFile & Chr(13) & Chr(13) & "Error=" & Err.Description, vbCritical, "Rename files"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True
End Sub


==== ===========

Can you help me tweak the codes about to get below results (New Name Final)?

=================

RESULTS:

Main (Sheet 1)

Headers: Row 13

xOldNameIIIIIINew Name(Final)(Insert Subject Here) Example: Algebra(Insert Date) Example: 0619
0001.xlsxBen_Math_0619.xlsx
0002.txtSean_Math_0619.txt
0003.xlsxMay_Math_0619.xlsx
0004.docBeth_Math_0619.doc

<tbody>
</tbody>

Reference (Sheet 2)

Headers: Row 1

Name (Old) Name (ChangeTo)SubjectSubject (ChangeTo)
0001BenMathMath
0002SeanAlgebraMath
0003MayTrigonometryMath
0004BethPhysicsScience

<tbody>
</tbody>

Note:

1.) I need to lookup for the account number (Old Name) to second tab to get the equivalent name
3.) I need to lookup up for the subject to get the equivalent specific subject
4.) Add the date stated in H13


Any help will be much appreciated. :)
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

Forum statistics

Threads
1,212,927
Messages
6,110,733
Members
448,294
Latest member
jmjmjmjmjmjm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top