Auto-generate/Populate Excel Worksheets from Data

Closed
Nuebee Posts 3 Registration date Tuesday May 1, 2018 Status Member Last seen May 3, 2018 - May 1, 2018 at 05:33 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - May 7, 2018 at 11:08 AM
Hello
I wonder if anyone could help me. I need to separate a list of data into separate worksheets based on the data in the first column. For example, I have a list of data containing multiple records for multiple branches, lets say my data range is A2:F25. Column A has my branch names - A2:A15 values are "North West", A16:A22= "Far North", A22:A25= "Central"...I would like to be able to automatically generate a new worksheet for each change in branch name and bringing across the rows of data for each of those branches. The first worksheet would be named "North West" and have all the data from A2:F15, the second would have data from A16:F22 and named "Far North" etc. I have searched the forum but nothing seems to be quite what I am looking for. Thank you in advance, I appreciate any help I can get.
Related:

4 responses

Blocked Profile
May 1, 2018 at 06:02 PM
Did you read this one:

https://ccm.net/faq/53497-how-to-manipulate-data-in-excel-using-vba

There is this one that will assist with the sheet creation
https://ccm.net/forum/affich-1044168-updating-a-sheet-name-in-excel-without-macros

Please understand, there is cut and paste code in there, but you need to understand what is a variable, what is an object(worksheet), and what is a METHOD (program Process).

Post some code, and we can help.
Well, I worked on it....

...if you need help, let us know.

 Function sheetexist(whatsheet)
On Error GoTo NotExists

ThisWorkbook.Worksheets(whatsheet).Select
sheetexist = True
Exit Function

NotExists:
sheetexist = False

End Function

Function testsheet(whichsheet, rowNum)
nret = sheetexist(whichsheet)
If nret = False Then
makesheet (whichsheet)
nret = copyrowX(whichsheet, rowNum)
Else
nret = copyrowX(whichsheet, rowNum)

End If
End Function

Sub makesheet(whatsheet)
On Error GoTo ExitSub
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = whatsheet
End With

ExitSub:

End Sub


Function copyrowX(towhatsheet, whatrow)
ThisWorkbook.Worksheets("Sheet1").Select
ThisWorkbook.Worksheets("Sheet1").Range("A" & whatrow).EntireRow.Select
Selection.Copy

ThisWorkbook.Worksheets(towhatsheet).Select
cellcount = Cells(ThisWorkbook.Worksheets(towhatsheet).Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Worksheets(towhatsheet).Range("A" & cellcount).EntireRow.Select
Selection.Insert

End Function


Sub ReadSheet()
cellcount = Cells(ThisWorkbook.Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row
For RowCount = 1 To cellcount
cellvalue = ThisWorkbook.Worksheets("Sheet1").Range("A" & RowCount).Value
nret = testsheet(cellvalue, RowCount)
ThisWorkbook.Worksheets("Sheet1").Select
Next
End Sub



What this does, is it takes the column of A on Sheet1, and reads each entry. Set the cell location to what ever fits. Then, it sees if there is a Worksheet named the same as the cell value in column A. If it does not find a sheet, it creates one, and copies the row from sheet1 and places it into the newly created sheet. If it finds one, it copies and paste it to the worksheet.
READSHEET() STARTS the process, so attach a button to READSHEEET!

Simple!

Nuebee Posts 3 Registration date Tuesday May 1, 2018 Status Member Last seen May 3, 2018
May 3, 2018 at 01:15 PM
Thanks so much ac3mark I will try thus today when I get in the office. Will let you know how it goes.
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Updated on May 3, 2018 at 11:40 AM
Such a different code structure then I would use. Due to the lack of Excel questions, I couldn't help myself to see how it worked.

I noticed that the first row from a branch block would be placed at the bottom of the destination sheet. Potentially messing up the order. In case the poster puts value in this, consider Mark's amended code [I hope you don't mind Mark :) ]:
Function sheetexist(whatsheet)
On Error GoTo NotExists

ThisWorkbook.Worksheets(whatsheet).Select
sheetexist = True
Exit Function

NotExists:
sheetexist = False

End Function

Function testsheet(whichsheet, rowNum)
nret = sheetexist(whichsheet)

If nret = False Then
    makesheet (whichsheet)
    nret = copyrowX(whichsheet, rowNum)
Else
    nret = copyrowX(whichsheet, rowNum)
End If

End Function

Sub makesheet(whatsheet)
On Error GoTo ExitSub

With ThisWorkbook
    .Sheets.Add(After:=.Sheets("Sheet1")).Name = whatsheet
End With

ExitSub:
End Sub

Function copyrowX(towhatsheet, whatrow)
ThisWorkbook.Worksheets("Sheet1").Select
ThisWorkbook.Worksheets("Sheet1").Range("A" & whatrow).EntireRow.Select
Selection.Copy

ThisWorkbook.Worksheets(towhatsheet).Select
ThisWorkbook.Worksheets(towhatsheet).Rows(1).Select
Selection.Insert

End Function

Sub ReadSheet()
cellcount = Cells(ThisWorkbook.Worksheets("Sheet1").Rows.Count, 1).End(xlUp).Row

For RowCount = cellcount To 1 Step -1
    cellvalue = ThisWorkbook.Worksheets("Sheet1").Range("A" & RowCount).Value
    nret = testsheet(cellvalue, RowCount)
    ThisWorkbook.Worksheets("Sheet1").Select
Next

Application.CutCopyMode = False

End Sub



Nuebee Posts 3 Registration date Tuesday May 1, 2018 Status Member Last seen May 3, 2018
May 3, 2018 at 01:17 PM
Thanks TrowaD I appreciate the time you both have spent helping me. I'm off to the office today, I'll try it and let you know how it goes.
0
Blocked Profile
May 3, 2018 at 05:17 PM
I see the reverse order, Yes that is valuable! Thank you sir!
0
Blocked Profile
May 3, 2018 at 05:25 PM
I thought of another addendum to this, in the TESTSHEET() function we could change it to:

Function testsheet(whichsheet, rowNum)
nret = sheetexist(whichsheet)

If nret = False Then makesheet (whichsheet)
       nret = copyrowX(whichsheet, rowNum)
End Function
 
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
May 7, 2018 at 11:08 AM
Nice, that saves up 4 rows.
0