Macro for Creating WorkSheets

V

vinayguj

New Member
Joined
Jul 8, 2012
Messages
11
Hi All,

I need help for the below activity. I am not well versed in Macros. Below is the scenario.

1. I have one Workbook, with two Worksheets named as; "People" & "Masterfile"

In People Worksheet the Data is as below:

Column A
Column B
Column C
Column D
Column E
Column F
Row 1
Reg No.
Name
Credit
Debit
Reason
Week Nos.
Row 2
1
Ajay
10
To buy stationary
5
Row 3
2
Vijay
30
To buy stationary
5
Row 4
3
Sujay
50
Paid back pending
5
Row 5
4
Ajay
40
Paid for transport
6

<tbody>
</tbody>


Masterfile worksheet has following data:

Column A
Column B
Column C
Column D
Row 1
Name
Row 2
Row 3
Transactions Reason
Week Nos.
Debit
Creadit
Row 4
Row 5

<tbody>
</tbody>


The Macro should
1. Create number of "Masterfile" worksheets based on the number of Names in the "People" worksheet, and rename the worksheet with the name, but if already created, then do not create again.
For Example: Worksheets by Name: "Ajay", "Vijay", "Sujay"

2. In the Worksheet "Ajay", the details of Name, Transaction Reason, Week Nos., Debit, Credit, should be filled corresponding to the Data in the "People" Worksheet. For Example:

Column A
Column B
Column C
Column D
Row 1
Name
Ajay
Row 2
Row 3
Transactions Reason
Week Nos.
Debit
Creadit
Row 4
To buy stationary
5
10
Row 5
Paid for transport
640

<tbody>
</tbody>


3. Similarly in other worksheets of Vijay and Sujay.

I hope somebody helps at the earliest.

Thanks in Advance.
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Sort by date Sort by votes
vinayguj said:
Hi All,

I need help for the below activity. I am not well versed in Macros. Below is the scenario.

1. I have one Workbook, with two Worksheets named as; "People" & "Masterfile"

In People Worksheet the Data is as below:

Column A
Column B
Column C
Column D
Column E
Column F
Row 1
Reg No.
Name
Credit
Debit
Reason
Week Nos.
Row 2
1
Ajay
10
To buy stationary
5
Row 3
2
Vijay
30
To buy stationary
5
Row 4
3
Sujay
50
Paid back pending
5
Row 5
4
Ajay
40
Paid for transport
6

<TBODY>
</TBODY>


Masterfile worksheet has following data:

Column A
Column B
Column C
Column D
Row 1
Name
Row 2
Row 3
Transactions Reason
Week Nos.
Debit
Creadit
Row 4
Row 5

<TBODY>
</TBODY>


The Macro should
1. Create number of "Masterfile" worksheets based on the number of Names in the "People" worksheet, and rename the worksheet with the name, but if already created, then do not create again.
For Example: Worksheets by Name: "Ajay", "Vijay", "Sujay"

2. In the Worksheet "Ajay", the details of Name, Transaction Reason, Week Nos., Debit, Credit, should be filled corresponding to the Data in the "People" Worksheet. For Example:

Column A
Column B
Column C
Column D
Row 1
Name
Ajay
Row 2
Row 3
Transactions Reason
Week Nos.
Debit
Creadit
Row 4
To buy stationary
5
10
Row 5
Paid for transport
6
40

<TBODY>
</TBODY>


3. Similarly in other worksheets of Vijay and Sujay.

I hope somebody helps at the earliest.

Thanks in Advance.
Click to expand...

I posted some code for similar problem recently & have updated it to hopefully, do what you want. Place both procedures below in a standard code module. Oh & BTW, stationEry for pens pencils etc is spelt with an E.</SPAN>
Hope helpful

dave

Option Explicit
Sub PersonData()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim Datarng As Range
Dim rowcount As Long
Dim Person As Range
Dim msg As Variant
Set ws1 = Sheets("People") '<< your master sheet
Application.ScreenUpdating = False
On Error GoTo myerror
With ws1
.Activate
.Unprotect Password:="" 'add password if needed
rowcount = .Cells(.Rows.Count, "A").End(xlUp).Row
Set Datarng = .Range("A1:F" & rowcount)
.Range("B1:B" & rowcount).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("J1"), _
Unique:=True

rowcount = .Cells(.Rows.Count, "J").End(xlUp).Row
'set Criteria
.Range("L1").Value = .Range("B1").Value

For Each Person In .Range("J2:J" & rowcount)
'add the Person to criteria
.Range("L2").Value = Person.Value
'if Person sheet exists
'update it
If SheetExists(Person.Value) Then
'clear old data except headers
Sheets(Person.Value).UsedRange.Offset(3, 0).Clear
'refresh data
Datarng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=ws1.Range("L1:L2"), _
CopyToRange:=Sheets(Person.Value).Range("A3:D3"), _
Unique:=False
'Sheets(Person.Value).UsedRange.Columns.AutoFit
Else
'add new sheet
Set wsNew = Sheets.Add
With wsNew
.Move After:=Worksheets(Worksheets.Count)
.Name = Person.Value
'Add headers
'name
.Range("A1").Value = ws1.Range("B1").Value
.Range("B1").Value = Person.Value
'reason
.Range("A3").Value = ws1.Range("E1").Value
'week no
.Range("B3").Value = ws1.Range("F1").Value
'Debit Credit
.Range("C3:D3").Value = ws1.Range("C1:D1").Value
End With

'add data
Datarng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=ws1.Range("L1:L2"), _
CopyToRange:=wsNew.Range("A3:D3"), _
Unique:=False
' wsNew.UsedRange.Columns.AutoFit
End If
Next
.Select
.Columns("J:L").Clear
End With
myerror:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
'something went wrong.
If Err > 0 Then msg = MsgBox(Error(Err), 16, "Error"): Err.Clear
End Sub

Function SheetExists(wksName As String) As Boolean
On Error Resume Next
SheetExists = CBool(Len(Worksheets(wksName).Name) > 0)
On Error GoTo 0
End Function
 
Upvote 0
Deleted. noticed an issue
 
Last edited:
Upvote 0
Thank you very much for the help Dave. Also thanks for correcting my bad English:)

It works, but, It would be better if the Masterfile be copied and created as a new worksheet and then renamed with the names.

I was telling about this part:

With wsNew
.Move After:=Worksheets(Worksheets.Count)
.Name = Person.Value
'Add headers
'name
.Range("A1").Value = ws1.Range("B1").Value
.Range("B1").Value = Person.Value
'reason
.Range("A3").Value = ws1.Range("E1").Value
'week no
.Range("B3").Value = ws1.Range("F1").Value
'Debit Credit
.Range("C3:D3").Value = ws1.Range("C1:D1").Value
End With


These codes create the content of the Masterfile manually. By typing in A1 as Name, then A3 as Transaction reason, etc.
But can the whole of Masterfile be just copy and pasted then rename with the name of the person.
 
Upvote 0
Thanks very much for you help Dave. It really worked out.

But can the "Masterfile" sheet be copied wholely and create new worksheet and then be renamed?
 
Upvote 0
The code didn't allow for
but if already created, then do not create again
Click to expand...
If I get time I'll have a look at it later
 
Upvote 0
Hi Guys,

I was going to offer a solution but noticed Dave's post. Here is what I have. PAste the code in the ThisWorkbook module.

The code sorts the data on column B in the People sheet first of all.

Code: 
[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Sub[/COLOR] CreateNamedWorksheets()
   [COLOR=darkblue]Dim[/COLOR] wsNew [COLOR=darkblue]As[/COLOR] Worksheet     [COLOR=green]'new worksheet[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] rng [COLOR=darkblue]As[/COLOR] Range           'People sheet loop range
   [COLOR=darkblue]Dim[/COLOR] SheetName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]    [COLOR=green]'new worksheet name[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] rw [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]             [COLOR=green]'next available row[/COLOR]
   
   [COLOR=green]'sort the data[/COLOR]
   SortColumnB
   
   [COLOR=green]'loop through the data until column B(name) has no value[/COLOR]
   [COLOR=darkblue]Set[/COLOR] rng = Sheets("People").Range("B2")
   [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] rng = ""
      
      [COLOR=green]'check the sheet exists[/COLOR]
      SheetName = rng.Value
      [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] WorksheetExists(SheetName) [COLOR=darkblue]Then[/COLOR]
         Sheets("Masterfile").Copy After:=Worksheets(Worksheets.Count)
         ActiveSheet.Name = SheetName
         [COLOR=darkblue]Set[/COLOR] wsNew = Sheets(SheetName)
      [COLOR=darkblue]Else[/COLOR]
         [COLOR=darkblue]Set[/COLOR] wsNew = Sheets(SheetName)
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]


      [COLOR=green]'process name[/COLOR]
      [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] rng.Value = SheetName
         [COLOR=darkblue]With[/COLOR] wsNew
            rw = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & rw).Value = rng.Offset(, 3).Value  [COLOR=green]'Sheets(People) Column(E)[/COLOR]
            .Range("B" & rw).Value = rng.Offset(, 4).Value  [COLOR=green]'Sheets(People) Column(F)[/COLOR]
            .Range("C" & rw).Value = rng.Offset(, 2).Value  [COLOR=green]'Sheets(People) Column(D)[/COLOR]
            .Range("D" & rw).Value = rng.Offset(, 1).Value  [COLOR=green]'Sheets(People) Column(C)[/COLOR]
         [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
         
         [COLOR=darkblue]Set[/COLOR] rng = rng.Offset(1, 0)
      [COLOR=darkblue]Loop[/COLOR]
   Loop
   
   [COLOR=darkblue]Set[/COLOR] rng = [COLOR=darkblue]Nothing[/COLOR]
   [COLOR=darkblue]Set[/COLOR] wsNew = [COLOR=darkblue]Nothing[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]




[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] SortColumnB()
   Worksheets("People").Range("B1").Sort _
        Key1:=Worksheets("People").Columns("B"), _
        Header:=[COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]






[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Function[/COLOR] WorksheetExists([COLOR=darkblue]ByVal[/COLOR] SheetName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]) [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Boolean[/COLOR]
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
      WorksheetExists = Sheets(SheetName).Name = SheetName
   [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]
 
Upvote 0
vinayguj said:
Thank you very much for the help Dave. Also thanks for correcting my bad English:)

It works, but, It would be better if the Masterfile be copied and created as a new worksheet and then renamed with the names.

I was telling about this part:

With wsNew
.Move After:=Worksheets(Worksheets.Count)
.Name = Person.Value
'Add headers
'name
.Range("A1").Value = ws1.Range("B1").Value
.Range("B1").Value = Person.Value
'reason
.Range("A3").Value = ws1.Range("E1").Value
'week no
.Range("B3").Value = ws1.Range("F1").Value
'Debit Credit
.Range("C3:D3").Value = ws1.Range("C1:D1").Value
End With


These codes create the content of the Masterfile manually. By typing in A1 as Name, then A3 as Transaction reason, etc.
But can the whole of Masterfile be just copy and pasted then rename with the name of the person.
Click to expand...

If it’s producing correct result not sure why you would want to copy a “master” sheet unless you have other data on it? Also, there is a good reason for approach I took. When using autofilter the field headings MUST match the data table you are extracting data from. In your example, one of the headings is different & this would cause an error. Code could be adjusted but if it is doing what you want, I would leave it.</SPAN>
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Update row data using another worksheet data
Replies
1
Views
154
denz0215
D
T
  • Solved
Making the contents of the active cell the search term, and search using that term, copy paste row, next
Replies
2
Views
184
Travis Kunnen
T
Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
357
Agnarr
Agnarr
B
  • Solved
vba code to give next Sunday date for pasted data
Replies
2
Views
190
bh24524
B
S
  • Question
Can a macro help create a user hierarchy?
Replies
7
Views
186
Akuini
Akuini

Forum statistics

Threads
1,215,093
Messages
6,123,069
Members
449,090
Latest member
fragment

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top