I have to manipulate a gigantic excel file, but I had some problems using VBA.
This this excel file has 28 tabs and all have 53 columns. The tabs are about years, some years have more persons in. All the first column its about Person_system_ID and the second its his name, all of them are in uppercase.
I tried to use ChatGPT to write a VBA code to map all the tabs and create a separate tab for each unique name and save, but I got some errors.
Here is the code that ChatGPT wrote:
Function IsInArray(arr, val) As Boolean
Dim found As Boolean
found = False
If IsArray(arr) And Not IsEmpty(arr) Then
Dim i As Long
For i = LBound(arr) To UBound(arr)
If arr(i) = val Then
found = True
Exit For
End If
Next i
End If
IsInArray = found
End Function
Sub Create_Individual_Sheets()
Dim SheetName As String
Dim NameList() As String
Dim LastRow As Long
Dim Year As Integer
Dim Sheet As Worksheet
Dim NewSheet As Worksheet
Dim Name As Variant
Dim i As Long
Dim Folder As String
Folder = "C:\Users\Jorjao\Desktop\Folder"
For Year = 1994 To 2022
Set Sheet = Worksheets(CStr(Year))
LastRow = Sheet.Cells(Rows.Count, 1).End(xlUp).Row
'loop through the name column in the current sheet and add to the name list
For i = 2 To LastRow
Name = UCase(Sheet.Cells(i, 2).Value)
If Not IsInArray(NameList, Name) Then
ReDim Preserve NameList(UBound(NameList) + 1)
NameList(UBound(NameList)) = Name
End If
Next i
Next Year
'loop through the name list and create an individual sheet for each name
For Each Name In NameList
Set NewSheet = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
SheetName = Replace(Name, " ", "_")
NewSheet.Name = SheetName
'loop through each sheet and copy the rows with the current name to the individual sheet
For Year = 1994 To 2022
Set Sheet = Worksheets(CStr(Year))
LastRow = Sheet.Cells(Rows.Count, 1).End(xlUp).Row
'loop through the name column in the current sheet and check if the current name is present
For i = 2 To LastRow
If UCase(Sheet.Cells(i, 2).Value) = Name Then
Sheet.Rows(i).Copy Destination:=NewSheet.Rows(NewSheet.Cells(Rows.Count, 1).End(xlUp).Row.Offset(1))
End If
Next i
Next Year
'save the new sheet in a folder
NewSheet.Copy
ActiveWorkbook.SaveAs Filename:=Folder & SheetName & ".xlsx"
ActiveWorkbook.Close savechanges:=False
Next Name
End Sub
Using this code, I got:
Runtime error
9Subscript out of range
I also tried to change somethings, but I also got some runtime error like 13 and 424.
The problem description does not contain all the elements for a sure implementation. It looks more like a pitfall exercise... So one answer to the problem is: You create an xlsm file where you copy the following code in a module. In this book you run SUB helper() after first fixing the target file path. The code does the following: a) Opens the target file b) Reads the leaf data from cell A2 assuming there are headers. The number of rows is calculated while the columns are 53. The data of all sheets is written to the current sheet of the book. c) We close the target book d) We sort the data by ID code of the first column and not by name because I think the code is unique while the name maybe not e) We go through the entire column A and in each case that the code changes we create a new sheet and copy the block with the current code/person. The sheet renamed to "ID_" and the id g) At the end, if we want, we delete the sheet that has all the data.
So to recap, we put this code into a new xlsm file and it reads all the sheets of another excel workbook and creates as many sheets as there are distinct person codes in the data it read.