Want to Add New sheet for every new client thru VBA code automatically [SOLVED]

smittal · May 15, 2013

Hi,

I am Beginner in VBA. i am working on a project in which if you update any client name in your db and tagged with project manager then it will automatically link with Project manager sheet.

Now, i want to add a new worksheet for every new entry in column A ... means column A of sheets("raw") contains the client name... what i want.. whenever i add any new client in DB then automatically a New worksheet will add and copy the format from previous sheet and the worksheet name would be the client name (Max 20 Length)...

sgmpatnaik · May 15, 2013

@smittal

Hi

Please add the below code in your DB sheet and when You add a new name in that worksheet Column A then the new sheet is added and sheet name is renamed with the particular name

[pre]

Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Dim n As Integer
Dim SheetExists As Boolean
If Target.Cells.Count &#62; 1 Then Exit Sub

On Error GoTo ResetApplication
Application.EnableEvents = False

Set isect = Intersect(Target, Range(&#34;A:A&#34;))

If Not isect Is Nothing And Target &#60;&#62; &#34;&#34; Then
For n = 1 To Sheets.Count
If Sheets(n).Name = Target Then
SheetExists = True
Exit For
End If
Next
If Not SheetExists Then
ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)

ActiveSheet.Name = Target

Me.Activate
Target.Select
Sheets(&#34;Party Sheet&#34;).Range(&#34;A:Z&#34;).Copy Sheets(Target.Value).Range(&#34;A1&#34;) &#39;Chage the sheet name as you desire

With Sheets(Target.Value)
.Range(&#34;B2&#34;).Value = .Name
End With
Sheets(Target.Value).Activate
End If
End If

ResetApplication:
Err.Clear
On Error GoTo 0
Application.EnableEvents = True
Set isect = Nothing
End Sub

[/pre]

Before add the code please change the sheet name of your required

Sheets("Party Sheet").Range("A:Z").Copy Sheets(Target.Value).Range("A1")

Hope it is solve your problem otherwise please inform us

Thanks

SP

smittal · May 16, 2013

thanks a ton

but need to know in which Module i have to apply this code...

i had used this in DB sheet but its not working there... please confirm where i need to use

i have used various modules.. either i used anyone of that or i create a new module for same.... or

Appreciate anyone help please

sgmpatnaik · May 16, 2013

@smittal

Hi

Which code was given by me just copy the code and paste in your DB Worksheet to paste the code please follow the instruction

1. Select the Sheet DB in the sheet name

2. right click the mouse button

3. Select the View Code Option and paste the code

4. Change the Sheet Name which sheet to be copied

Sheets("Party Sheet").Range("A:Z").Copy Sheets(Target.Value).Range("A1")

still you are facing the problem then it is better to upload a sample file

to post a sample file please go through this link http://chandoo.org/forums/topic/posting-a-sample-workbook

Thanks

SP

smittal · May 22, 2013

Hi SP..

I already have a Drop box account. can you please share your ID to share folder with you.

thanks in Advance

smittal

sgmpatnaik · May 22, 2013

@smittal

Hi

There is no need to share the ID, you just copy the file and paste in your dropbox after that you will get a link and copy the link and paste here

Thanks

SP

sgmpatnaik · May 23, 2013

@smittal

Hi

i can't understand what's wrong ; any how please try to download the below file and check is this exactly what you want or not

here i create on Master Sheet Named with DB and I place the above code in the master sheet and i create another sheet named with Copy Sheet this sheet is base sheet when you enter the party name in the DB Sheet of Column A then the code is create a new sheet

https://dl.dropboxusercontent.com/u/75654703/Smittal_001.xlsm

Hope it will give some idea other wise please inform us

Thanks

SP

smittal · May 24, 2013

Hi SP,

Apology for Miss-confusing @ Drop box.

Thanks for the Above link... this is the Exactly same which i was looking for.

Will try and Update on post.

sgmpatnaik · May 24, 2013

sure we will wait for you replay

smittal · May 24, 2013

Thank you SP

You have resolved my Issue.

Can you please help me little more....

for every new entry in column (A) i have to copy the below mention code as well...this code is linked with access DB...

Sub smittal()

Dim scon As String

Dim con As New ADODB.Connection

Dim rs As New ADODB.Recordset

Dim xselect As String

Dim vert As String

Dim mth As String

Dim msg As String

Dim lrow As Integer

Dim clientname As String

Application.ScreenUpdating = False

Application.DisplayAlerts = False

clientname = Sheet3.Range("B1").Text

Sheet3.Select

Range("B214:C214").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.ClearContents

'Connection With Access Database

scon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "KRA.accdb;Persist Security Info=False;Jet OLEDB;"

' Query to Fetch the Data from Access

xselect = " SELECT SEO_Keyword.Key_rank, SEO_Keyword.Keywords" & _

" FROM SEO_Keyword" & _

" GROUP BY SEO_Keyword.Key_rank, SEO_Keyword.Keywords, SEO_Keyword.CName, SEO_Keyword.Keywords_count" & _

" HAVING (((SEO_Keyword.CName)= '" & clientname & "'))" & _

" ORDER BY SEO_Keyword.Keywords_count;"

con.ConnectionString = scon

con.Open

rs.Open xselect, con

Sheet3.Range("B214").CopyFromRecordset rs

ActiveWorkbook.Save

rs.Close

con.Close

Application.StatusBar = ""

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

same code i want to copy for each New entry

Thanks in Advance for your help

sgmpatnaik · May 25, 2013

@smittal

Hi

Glad we solve your problem

for you second request i think i can't do that but if you paste your Code in the Copy Sheet then i can move that with a simple change of the my code please down load the file from the given link in this file it will copy the entire worksheet with your code and rename the sheet name with cell value

https://dl.dropboxusercontent.com/u/75654703/Smittal_2.xlsm

[pre]

Code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Range
Dim n As Integer
Dim SheetExists As Boolean
If Target.Cells.Count &#62; 1 Then Exit Sub

On Error GoTo ResetApplication
Application.EnableEvents = False

Set isect = Intersect(Target, Range(&#34;A:A&#34;))

If Not isect Is Nothing And Target &#60;&#62; &#34;&#34; Then
For n = 1 To Sheets.Count
If Sheets(n).Name = Target Then
SheetExists = True
Exit For
End If
Next
If Not SheetExists Then
ActiveWorkbook.Sheets(&#34;Copy Sheet&#34;).Copy After:=ActiveWorkbook.Sheets(Sheets.Count)

ActiveSheet.Name = Target

Me.Activate
Target.Select

Sheets(&#34;Copy Sheet&#34;).Range(&#34;A:Z&#34;).Copy Sheets(Target.Value).Range(&#34;A1&#34;) &#39;Chage the sheet name as you desire

With Sheets(Target.Value)
.Range(&#34;B2&#34;).Value = .Name
End With
Sheets(Target.Value).Activate
End If
End If

ResetApplication:
Err.Clear
On Error GoTo 0
Application.EnableEvents = True
Set isect = Nothing
End Sub

[/pre]

Hope it is solve your problem other wise please inform us

Thanks

SP

smittal · Jul 5, 2013

i want to tag this topic with [solved]. please suggest

sgmpatnaik · Jul 5, 2013

@smittal

Hi

we can't tag any topic as solved if you give a comment as problem resolved or problem solved then our ninja's can tag the post as solved

Thanks

SP

smittal · Jul 6, 2013

Thanks SP for the same.

problem solved

Want to Add New sheet for every new client thru VBA code automatically [SOLVED]

smittal

Member

sgmpatnaik

Active Member

smittal

Member

sgmpatnaik

Active Member

smittal

Member

sgmpatnaik

Active Member

sgmpatnaik

Active Member

smittal

Member

sgmpatnaik

Active Member

smittal

Member

sgmpatnaik

Active Member

smittal

Member

sgmpatnaik

Active Member

smittal

Member