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:

[TABLE="width: 673"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]Column A
[/TD]
[TD="align: center"]Column B
[/TD]
[TD="align: center"]Column C
[/TD]
[TD="align: center"]Column D
[/TD]
[TD="align: center"]Column E
[/TD]
[TD="align: center"]Column F
[/TD]
[/TR]
[TR]
[TD="align: center"]Row 1
[/TD]
[TD="align: center"]Reg No.
[/TD]
[TD="align: center"]Name
[/TD]
[TD="align: center"]Credit
[/TD]
[TD="align: center"]Debit
[/TD]
[TD="align: center"]Reason
[/TD]
[TD="align: center"]Week Nos.
[/TD]
[/TR]
[TR]
[TD="align: center"]Row 2
[/TD]
[TD="align: center"]1
[/TD]
[TD="align: center"]Ajay
[/TD]
[TD="align: center"]10
[/TD]
[TD="align: center"][/TD]
[TD="align: center"]To buy stationary
[/TD]
[TD="align: center"]5
[/TD]
[/TR]
[TR]
[TD="align: center"]Row 3
[/TD]
[TD="align: center"]2
[/TD]
[TD="align: center"]Vijay
[/TD]
[TD="align: center"]30
[/TD]
[TD="align: center"][/TD]
[TD="align: center"]To buy stationary
[/TD]
[TD="align: center"]5
[/TD]
[/TR]
[TR]
[TD="align: center"]Row 4
[/TD]
[TD="align: center"]3
[/TD]
[TD="align: center"]Sujay
[/TD]
[TD="align: center"][/TD]
[TD="align: center"]50
[/TD]
[TD="align: center"]Paid back pending
[/TD]
[TD="align: center"]5
[/TD]
[/TR]
[TR]
[TD="align: center"]Row 5
[/TD]
[TD="align: center"]4
[/TD]
[TD="align: center"]Ajay
[/TD]
[TD="align: center"]40
[/TD]
[TD="align: center"][/TD]
[TD="align: center"]Paid for transport
[/TD]
[TD="align: center"]6
[/TD]
[/TR]
</tbody>[/TABLE]


Masterfile worksheet has following data:

[TABLE="width: 420"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]Column A
[/TD]
[TD="align: center"]Column B
[/TD]
[TD="align: center"]Column C
[/TD]
[TD="align: center"]Column D
[/TD]
[/TR]
[TR]
[TD="align: center"]Row 1
[/TD]
[TD="align: center"]Name
[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Row 2
[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Row 3
[/TD]
[TD="align: center"]Transactions Reason
[/TD]
[TD="align: center"]Week Nos.
[/TD]
[TD="align: center"]Debit
[/TD]
[TD="align: center"]Creadit
[/TD]
[/TR]
[TR]
[TD="align: center"]Row 4
[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Row 5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


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:

[TABLE="width: 420"]
<tbody>[TR]
[TD][/TD]
[TD="align: center"]Column A
[/TD]
[TD="align: center"]Column B
[/TD]
[TD="align: center"]Column C
[/TD]
[TD="align: center"]Column D
[/TD]
[/TR]
[TR]
[TD="align: center"]Row 1
[/TD]
[TD="align: center"]Name
[/TD]
[TD="align: center"]Ajay
[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Row 2
[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD="align: center"]Row 3
[/TD]
[TD="align: center"]Transactions Reason
[/TD]
[TD="align: center"]Week Nos.
[/TD]
[TD="align: center"]Debit
[/TD]
[TD="align: center"]Creadit
[/TD]
[/TR]
[TR]
[TD="align: center"]Row 4
[/TD]
[TD="align: center"]To buy stationary
[/TD]
[TD="align: center"]5
[/TD]
[TD="align: center"][/TD]
[TD="align: center"]10
[/TD]
[/TR]
[TR]
[TD="align: center"]Row 5
[/TD]
[TD="align: center"]Paid for transport
[/TD]
[TD="align: center"]6[/TD]
[TD][/TD]
[TD="align: center"]40[/TD]
[/TR]
</tbody>[/TABLE]


3. Similarly in other worksheets of Vijay and Sujay.

I hope somebody helps at the earliest.

Thanks in Advance.
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
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:

[TABLE="width: 673"]
<TBODY>[TR]
[TD][/TD]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[TD]Column D
[/TD]
[TD]Column E
[/TD]
[TD]Column F
[/TD]
[/TR]
[TR]
[TD]Row 1
[/TD]
[TD]Reg No.
[/TD]
[TD]Name
[/TD]
[TD]Credit
[/TD]
[TD]Debit
[/TD]
[TD]Reason
[/TD]
[TD]Week Nos.
[/TD]
[/TR]
[TR]
[TD]Row 2
[/TD]
[TD]1
[/TD]
[TD]Ajay
[/TD]
[TD]10
[/TD]
[TD][/TD]
[TD]To buy stationary
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD]Row 3
[/TD]
[TD]2
[/TD]
[TD]Vijay
[/TD]
[TD]30
[/TD]
[TD][/TD]
[TD]To buy stationary
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD]Row 4
[/TD]
[TD]3
[/TD]
[TD]Sujay
[/TD]
[TD][/TD]
[TD]50
[/TD]
[TD]Paid back pending
[/TD]
[TD]5
[/TD]
[/TR]
[TR]
[TD]Row 5
[/TD]
[TD]4
[/TD]
[TD]Ajay
[/TD]
[TD]40
[/TD]
[TD][/TD]
[TD]Paid for transport
[/TD]
[TD]6
[/TD]
[/TR]
</TBODY>[/TABLE]


Masterfile worksheet has following data:

[TABLE="width: 420"]
<TBODY>[TR]
[TD][/TD]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[TD]Column D
[/TD]
[/TR]
[TR]
[TD]Row 1
[/TD]
[TD]Name
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row 2
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row 3
[/TD]
[TD]Transactions Reason
[/TD]
[TD]Week Nos.
[/TD]
[TD]Debit
[/TD]
[TD]Creadit
[/TD]
[/TR]
[TR]
[TD]Row 4
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row 5
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</TBODY>[/TABLE]


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:

[TABLE="width: 420"]
<TBODY>[TR]
[TD][/TD]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[TD]Column D
[/TD]
[/TR]
[TR]
[TD]Row 1
[/TD]
[TD]Name
[/TD]
[TD]Ajay
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row 2
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Row 3
[/TD]
[TD]Transactions Reason
[/TD]
[TD]Week Nos.
[/TD]
[TD]Debit
[/TD]
[TD]Creadit
[/TD]
[/TR]
[TR]
[TD]Row 4
[/TD]
[TD]To buy stationary
[/TD]
[TD]5
[/TD]
[TD][/TD]
[TD]10
[/TD]
[/TR]
[TR]
[TD]Row 5
[/TD]
[TD]Paid for transport
[/TD]
[TD]6
[/TD]
[TD][/TD]
[TD]40
[/TD]
[/TR]
</TBODY>[/TABLE]


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

J
  • Question Question
Using Sheets().Select in a Worksheet_Activate() macro
2
Replies
10
Views
424
jdun
J
C
  • Question Question
Creating a Card Flipper using VBA
Replies
0
Views
203
Cquake
C
W
  • Question Question
Macro/VBA code code for creating new excel file for each pivot table from a column filter
Replies
1
Views
357
Anthony47
A
N
  • Question Question
Finding the differences then copy and paste code to a new sheet
Replies
1
Views
580
myall_blues
myall_blues
Z
  • Question Question
VBA Process Flow Chart using Shapes & Connectors
Replies
2
Views
140
zlotowlosapl
Z

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

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