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.
**********Old code in sheet1**********
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
w.Activate
Set w = ActiveWorkbook
Sheets(1).Select 'In sheet 1 B1 value is changed to ver 2
Range("A1").Select
l = Range("B1").Value
o = Len(l)
p = Right(l, 1)
u = o - p
Ex = Left(l, u)
Con = Ex & j
Ex = Left(l, u)
Con = Ex & j
Range("B1").Value = Con
Range("D1:D8").ClearFormats
End if
Next w
***********New code in sheet2 shown below***********
For Each w In Workbooks
If Not w Is ThisWorkbook Then
With w
.Activate
If .Sheets.Count >= 2 Then
.Sheets(2).Select
If .Sheets(2).Range("A5").Value = "" Then
.Sheets(2).Range("A5").Select
.Sheets(2).Range(Selection, _
Selection.End(xlToRight)).ClearFormats
.Sheets(2).Range("A3").Select
.Sheets(1).Select
End If
Stop
.Close SaveChanges:=True
End If
End With
End If
Next w
Application.ScreenUpdating = True
End Sub
CodePudding user response:
So, I would do, in order to help easy with your code, will add and if before the error, with the Sheets.Count. Also, the if
did not work for me, so I added Thisworkbook.Name
See below:
For Each w In Workbooks
If Not w.Name = ThisWorkbook.Name Then
With w
.Activate
If .Sheets.Count >= 2 Then
'Here you can add more Sheets
With Sheets(1)
'Here You can Add More Code per Sheet
.Activate
'...
End With
With Sheets(2)
.Activate
If .Range("A5").Value = "" Then
.Range("A5").Select
.Range(Selection, Selection.End(xlToRight)).ClearFormats
.Range("A3").Select
End If
End With
.Close SaveChanges:=True
End If
End With
End If
Next w
Try to Use With
Command, it helps to read the code and also make it faster.
Other thing, try to avoid .Select
, please read this remarkable post and learn how to manage it. How to Avoid Select