Home > Blockchain >  File Editing Automation
File Editing Automation

Time:12-26

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
  • Related