I get run time error 9 while running the below sub routine at the line Sheets(2).Select. I checked in the immediate window for Activeworkbook.Name I get the correct workbook name. But not sure why subscript out of range error is thrown. ThisWorkbook has only sheet1, so I am guessing it is somehow referring to ThisWorkbook not ActiveWorkbook. How to correct it. I have also tried alternate lines of code it did not help. ActiveSheet.Next.Select
Sheets(1).Next.Select
The subroutine will clear formats if A5 value is blank in all workbooks.
Sub REReplace()
Dim Folder As String, FileName As String
Dim tWB, w As Workbook
Application.ScreenUpdating = False
Set tWB = ThisWorkbook
Folder = "C:\New\test"
FileName = Dir(Folder & "\*.xlsx")
Do
Workbooks.Open Folder & "\" & FileName
FileName = Dir
Loop Until FileName = ""
For Each w In Workbooks
If Not w Is ThisWorkbook Then
w.Activate
Sheets(2).Select
If Sheets(2).Range("A5").Value = "" Then
Sheets(2).Range("A5").Select
Sheets(2).Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearFormats
Sheets(2).Range("A3").Select
End If
w.Close SaveChanges:=True
End If
Next w
Application.ScreenUpdating = True
End Sub
The below code will replace the last value of the document number from 1 to 2 e.g BCR-98946210371-001 to BCR-98946210371-002 and removes formatting from cells D1:D8 in sheet1. Now I have additional requirement in sheet2 as posted in my question. I need to clear formats from row A5:Q5 if its blank.
**********Combined code in sheet1 and sheet2**********
Sub REReplace()
Dim Folder As String, FileName As String
Dim tWB, w As Workbook
Dim n As String
Dim j As String, Ex As String, Con, l As String
Dim o As Integer, p As Integer, u As Integer
Application.ScreenUpdating = False
j = "2"
Set tWB = ThisWorkbook
Folder = "C:\new\test"
FileName = Dir(Folder & "\*.xlsx")
Do
Workbooks.Open Folder & "\" & FileName
FileName = Dir
Loop Until FileName = ""
For Each w In Workbooks
If Not w Is ThisWorkbook Then
With w
.Activate
If .Sheets.Count >= 2 Then
With Sheets(1)
'Here You can Add More Code per Sheet
.Activate
l = .Range("B1").Value
o = Len(l)
p = Right(l, 1)
u = o - p
Ex = Left(l, u)
Con = Ex & j
.Range("B1").Value = Con
.Range("D1:D8").ClearFormats
End With
With Sheets(2)
'Here You can Add More Code per Sheet
.Activate
If .Range("A5").Value = "" Then
.Range("A5").Select
.Range(Selection, Selection.End(xlToRight)).ClearFormats
.Range("A3").Select
End If
End With
.Sheets(1).Activate
.Close SaveChanges:=True
End If
End With
End If
Next w
Application.ScreenUpdating = True
End Sub