0

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. enter image description here

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
newbie
  • 27
  • 5

1 Answers1

0

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

pepefiestas
  • 187
  • 8
  • It worked. However, the workbook stays open even though .Close SaveChanges:=True was present in the code. – newbie Aug 13 '22 at 08:05
  • I had to remove stop then it worked. Workbook is saved and closed. – newbie Aug 13 '22 at 08:15
  • How do I merge both these into one subroutine. For Each w In Workbooks If Not w Is ThisWorkbook Then w.Activate Set w = ActiveWorkbook Sheets(1).Select Range("A1").Select n = k Range("B13").Value = n 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 – newbie Aug 13 '22 at 08:22
  • I need to merge the sub routine in the above comment with the sub routine I posted. – newbie Aug 13 '22 at 08:26
  • Add comments in the code where to put more code per File and the more code per sheet. – pepefiestas Aug 13 '22 at 11:12
  • I have updated my original post with old code in sheet1 and new code in sheet2. After both the codes are merged. I run the combined code on each workbook in the folder using Do Loop. – newbie Aug 13 '22 at 15:29
  • 1
    I have merged both the codes and posted in my original post. It worked without any errors. – newbie Aug 14 '22 at 07:07