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.
CodePudding user response：
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
CodePudding user response：
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:
Since you are running the code in the same workbook, you do not need to set a workbook variable (which was
mainWBin your question) as you can simply refer to it asThisWorkbook.For reference, please read this answer on how to find last row/column.
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.