I wanna rename only two files from a folder using macro, Although there are lots files in that folder, but unable to do it. I wanna rename file name from "N2" to "NORTH 2 (UP/UK)" and "N3" to "NORTH 3 (HR/PB)". Also, I need to rename all values in first column named "zone", "from "N2" to "NORTH 2 (UP/UK)" and "N3" to "NORTH 3 (HR/PB)" using dynamic range of first column in each file.
I wish to just click on a button, and this task want to automate. Compiler automatically renames files, open each file one by one and replace existing zone values as per above condition and save the changes.
Question: How to assign dynamic range to below code .Worksheets(1).Cells(2, 1)
Please see following code:
Getting run-time error 53 while trying to rename file
Option Explicit
Sub FileOpen_Macro()
Dim FileName(0 To 1) As String
Dim ReplaceName(0 To 1) As String
Dim ReplaceZoneName(0 To 1) As String
'Dim FileName As String
Const MyPath As String = "D:\iWork\Dunning Report\Dec'21\Result\"
Dim strNewName As String
Dim i As Long
FileName(0) = "N2"
FileName(1) = "N3"
ReplaceName(0) = "North-2(UPUK).xlsx"
ReplaceName(1) = "North-3(HRPB).xlsx"
ReplaceZoneName(0) = "NORTH 2 (UP/UK)"
ReplaceZoneName(1) = "NORTH 3 (HR/PB)"
For i = 0 To 1
'strNewName = Replace(FileName(i), "N", ReplaceName(i))
strNewName = Replace(FileName(i) & ".xlsx", FileName(i) & ".xlsx", ReplaceName(i))
Name MyPath & FileName(i) & ".xlsx" As MyPath & ReplaceName(i)
With Workbooks.Open(FileName:=MyPath & strNewName)
' Replace the cell A1 of the first sheet.
.Worksheets(1).Cells(2, 1) = Replace(.Worksheets(1).Cells(2, 1), FileName(i), ReplaceZoneName(i))
'and Save & close
.Close SaveChanges:=True
End With
MsgBox strNewName
Next i
End Sub
CodePudding user response:
Use Range.Replace to update all cells in a range.
Sub Replace_Macro()
Const MyPath As String = "D:\iWork\Dunning Report\Dec'21\Result\"
Dim sOld as string, sNew as string, sZone As String
Dim lastrow As Long, i As Long, ar(1)
ar(0) = Array("N2", "North-2(UPUK)", "NORTH 2 (UP/UK)")
ar(1) = Array("N3", "North-3(HRPB)", "NORTH 3 (HR/PB)")
For i = 0 To UBound(ar)
sOld = ar(i)(0) & ".xlsx"
sNew = ar(i)(1) & ".xlsx"
sZone = ar(i)(2)
' check file exists
If Dir(MyPath & sOld) <> "" Then
With Workbooks.Open(MyPath & sOld)
With .Sheets(1)
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
' update column A
.Range("A2:A" & lastrow).Replace _
What:=ar(i)(0), Replacement:=sZone, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
MatchCase:=True
End With
' save as new name
.SaveAs FileName:=MyPath & sNew
.Close False
End With
' delete old file
If Dir(MyPath & sNew) <> "" Then
Kill MyPath & sOld
End If
Else
MsgBox MyPath & sOld & " does not exist", vbCritical
End If
Next i
MsgBox "Done"
End Sub