While statement returning Application / Object defined error "Error 1004"

Question

I am currently creating a macro that should be able to read through a set of data that looks like the below image and create new sheets based on the first 3 digits of the account number.

For example:

BKAsheet will have all the BKA accounts - then a new sheet will be created with all BPA accounts and so on

However, when I run the code I have, the program creates 1 sheet and stops there, then returns a application /Object defined error "Error 1004"

Please see the below code to see where the problem could be coming from

Option Explicit
Public mainWB As Workbook
Public mainWS As Worksheet
Public newWS As Worksheet

Sub Main()

'Creating New Variables
Dim TranstactDate As Date, AmountExcl As Double, Account As String
Dim mainR As Long, mainC As Long, newR As Long, newC As Long
Dim randNumber As Long
Dim accHolder As String
Dim path As String

newR = 2 'start of writing Row

path = ThisWorkbook.path

Set mainWB = Workbooks("arrears-formatter.xlsx") 'Setting mainWB
Set mainWS = mainWB.Worksheets("arrears-formatter") ' set mainWS to the working Worksheet

mainWB.Activate 'Shows that were working in the mainWB workbook
randNumber = Int((99999 - 10000 + 1) * Rnd + 10000) ' Generating a random number

TranstactDate = mainWS.Cells(1, 2) ' Set TransDate to the date that the user enters

For mainR = 9 To 100000 ' For all the rows in the mainWS
    If mainWS.Cells(mainR, 1) = "" Then GoTo exitthis: ' If the account col is blank , exitthis :
    
    accHolder = Left(mainWS.Cells(mainR, 1), 3) ' Defining the account letters (E.G. GLA)
    
    AmountExcl = mainWS.Cells(mainR, 3) ' Defining the interest included amount to print
    
    Account = mainWS.Cells(mainR, 1) 'Defining the full account number
    
    While Left(mainWS.Cells(mainR, 1), 3) = accHolder ' While the left of mainR 1  = the left of mainR 1 do
    
        mainWB.Sheets.Add.Name = accHolder & "-" & randNumber  ' Adding a sheet
        Set newWS = mainWB.Worksheets(accHolder & "-" & randNumber) 'Setting the Sheet
        
        'Determining new sheet values
        newWS.Cells(newR, 1) = mainWS.Cells(1, 2)
        newWS.Cells(newR, 2) = Account
        newWS.Cells(newR, 3) = "AR"
        newWS.Cells(newR, 4) = "Interest"
        newWS.Cells(newR, 5) = "0"
        newWS.Cells(newR, 6) = "7"
        newWS.Cells(newR, 7) = "Interest"
        newWS.Cells(newR, 8) = ""
        newWS.Cells(newR, 9) = AmountExcl
        newWS.Cells(newR, 10) = ""
        newWS.Cells(newR, 11) = ""
        newWS.Cells(newR, 12) = "0"
        newWS.Cells(newR, 13) = AmountExcl
        newWS.Cells(newR, 14) = "1"
        newWS.Cells(newR, 15) = AmountExcl
        newWS.Cells(newR, 16) = AmountExcl
        newWS.Cells(newR, 17) = "0"
        newWS.Cells(newR, 18) = "0"
        newWS.Cells(newR, 19) = ""
        newWS.Cells(newR, 20) = "0"
        newWS.Cells(newR, 21) = "0"
        newWS.Cells(newR, 22) = "0"
        newWS.Cells(newR, 23) = ""
        newWS.Cells(newR, 24) = ""
        newWS.Cells(newR, 25) = "0"
        newWS.Cells(newR, 26) = "0"
        newWS.Cells(newR, 27) = ""
        newWS.Cells(newR, 28) = "0"
        newWS.Cells(newR, 29) = "0"
        newWS.Cells(newR, 30) = "0"
        newWS.Cells(newR, 31) = "2750>050"
        newWS.Cells(newR, 32) = "0"
        newWS.Cells(newR, 33) = "0"
        
        newR = newR + 1 'Increasing new sheet row
        
        If Left(mainWS.Cells(mainR, 1), 3) <> accHolder Then GoTo exitthis: ' If the Account name is not the same , skip to the end of the loop

    Wend

exitthis:
Next mainR

End Sub

Please see the following link to my workbook.

Answer 1

It is hard to know without seeing the actual file, however I guess it is something to do with sheet name, so in a loop if you just change the sheet name to some other variable, just to debug if it is working in that case. If you upload the file it would hardly take 1 min to understand that.

Cheers

You are using static variable randNumber, you need to put this line after while loop as I put below, so every time the number get changed, since excel cant have worksheet with same name.

 While Left(mainWS.Cells(mainR, 1), 3) = accHolder
        randNumber = Int((99999 - 10000 + 1) * Rnd + 10000) ' this one
        mainWB.Sheets.Add.Name = accHolder & "-" & randNumber

Answer 2

I have tried to include comments in the code to explain what it's doing where necessary, please read it and feel free to ask if you do not understand any of it.

A few important points to note:

1. Since you are running the code in the same workbook, you do not need to set a workbook variable (which was mainWB in your question) as you can simply refer to it as ThisWorkbook .

2. For reference, please read this answer on how to find last row/column.

3. Reading/Writing value cell-by-cell is a very expensive process so it is recommended to write data to an array first then insert the array data into the worksheet once as it is much much faster.

Try the code below:

Option Explicit

Public mainWS As Worksheet
Public newWS As Worksheet

Sub Main()
    
    'Creating New Variables
    Dim TranstactDate As Date, AmountExcl As Double, Account As String
    Dim mainR As Long
    Dim randNumber As Long
    Dim accHolder As String    
                
    Set mainWS = ThisWorkbook.Worksheets("arrears-formatter") ' set mainWS to the working Worksheet
    
    randNumber = Int((99999 - 10000 + 1) * Rnd + 10000) ' Generating a random number
    
    TranstactDate = mainWS.Cells(1, 2) ' Set TransDate to the date that the user enters
    
    'Retrieve the last row in column A.
    Dim lastRow As Long
    lastRow = mainWS.Cells(mainWS.Rows.Count, 1).End(xlUp).Row
    
    '===========
    'Creates an array to store the static data, the commented out lines are either for dynamic data to be assigned later on or not needed since it's empty
    'The array will be used to populate the 33 columns of data at once which is faster than assigning the value cell-by-cell
    
    Dim inputArr(1 To 1, 1 To 33) As Variant
    inputArr(1, 1) = TranstactDate
    'inputArr(1, 2) = Account
    inputArr(1, 3) = "AR"
    inputArr(1, 4) = "Interest"
    inputArr(1, 5) = "0"
    inputArr(1, 6) = "7"
    inputArr(1, 7) = "Interest"
    'inputArr(1, 8) = ""
    'inputArr(1, 9) = AmountExcl
    'inputArr(1, 10) = ""
    'inputArr(1, 11) = ""
    inputArr(1, 12) = "0"
    'inputArr(1, 13) = AmountExcl
    inputArr(1, 14) = "1"
    'inputArr(1, 15) = AmountExcl
    'inputArr(1, 16) = AmountExcl
    inputArr(1, 17) = "0"
    inputArr(1, 18) = "0"
    'inputArr(1, 19) = ""
    inputArr(1, 20) = "0"
    inputArr(1, 21) = "0"
    inputArr(1, 22) = "0"
    'inputArr(1, 23) = ""
    'inputArr(1, 24) = ""
    inputArr(1, 25) = "0"
    inputArr(1, 26) = "0"
    'inputArr(1, 27) = ""
    inputArr(1, 28) = "0"
    inputArr(1, 29) = "0"
    inputArr(1, 30) = "0"
    inputArr(1, 31) = "2750>050"
    inputArr(1, 32) = "0"
    inputArr(1, 33) = "0"
    '===========
    
    For mainR = 9 To lastRow ' For all the rows in the mainWS
        
        accHolder = Left(mainWS.Cells(mainR, 1), 3) ' Defining the account letters (E.G. GLA)
        AmountExcl = mainWS.Cells(mainR, 3) ' Defining the interest included amount to print
        Account = mainWS.Cells(mainR, 1) 'Defining the full account number
        
        '===========
        'This portion will attempt to set newWS to the intended worksheet
        'If the worksheet does not exist, it will generate an error which is then captured in the If statement and handled by creating a new worksheet of the name and assign newWS to it
        On Error Resume Next
        Set newWS = ThisWorkbook.Worksheets(accHolder & "-" & randNumber)
        If Err.Number <> 0 Then
            Err.Clear
            Set newWS = ThisWorkbook.Worksheets.Add
            newWS.Name = accHolder & "-" & randNumber
        End If
        On Error GoTo 0
        '===========
            
        'Assigning the dynamic data to the array created previously
        inputArr(1, 2) = Account
        inputArr(1, 9) = AmountExcl
        inputArr(1, 13) = AmountExcl
        inputArr(1, 15) = AmountExcl
        inputArr(1, 16) = AmountExcl
        
        'Find the last empty row in newWS
        Dim newWSInsertRow As Long
        newWSInsertRow = newWS.Cells(newWS.Rows.Count, 1).End(xlUp).Row + 1
        
        'Insert the array data into the last empty row
        newWS.Cells(newWSInsertRow, 1).Resize(, 33).Value = inputArr
    Next mainR

End Sub

Note: I did not test it on your file even though you have linked it but it should work.