PC Review


Reply
Thread Tools Rate Thread

Create Worksheets

 
 
=?Utf-8?B?U2pha2tpZQ==?=
Guest
Posts: n/a
 
      24th Nov 2006
How do i change the script below to go through the list and have the
duplicates searched aswell but only
allow the name to be used once.

so that if there is

lead 1
lead 2
lead 3
lead 4
lead 4
lead 5
lead 6
lead 4

That it just makes the Worksheets
lead 1
lead 2
lead 3
lead 4
lead 5
lead 6


Sub SplitDump()

Dim sh As Worksheet, s As String
Dim i As Long, iloc as Long
Dim c As Range
Dim strAddress As String
Dim test As Integer

strMain = ActiveSheet.Name
i = 2
For Each c In Range("a1:a60")
strAddress = c.Address
If Len(c.Value) = 0 Then
MsgBox ("Finished")
Exit Sub
End If

If InStr(1, c.Value, "Lead:") Then
s = Trim(Right(c, Len(c) - 5))
iloc = Instr(1,s,"/",vbTextcompare)
if iloc <> 0 then
s = Trim(Left(s,iloc-1))
end if
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
i = 2
Else
c.Resize(1, 5).Copy sh.Cells(i, "A")
i = i + 1
End If
Next c

End Sub

 
Reply With Quote
 
 
 
 
Dave Peterson
Guest
Posts: n/a
 
      24th Nov 2006
Since you're adding sheets and renaming them immediately, you could just check
to see if that worksheet name already exists. If it does, just skip it.

This portion:
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s

Becomes:
set sh = nothing
on error resume next
set sh = sheets(s)
on error goto 0

'now check to see if that sheet didn't exist
if sh is nothing then
'it doesn't exist, so add it
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
end if




Sjakkie wrote:
>
> How do i change the script below to go through the list and have the
> duplicates searched aswell but only
> allow the name to be used once.
>
> so that if there is
>
> lead 1
> lead 2
> lead 3
> lead 4
> lead 4
> lead 5
> lead 6
> lead 4
>
> That it just makes the Worksheets
> lead 1
> lead 2
> lead 3
> lead 4
> lead 5
> lead 6
>
> Sub SplitDump()
>
> Dim sh As Worksheet, s As String
> Dim i As Long, iloc as Long
> Dim c As Range
> Dim strAddress As String
> Dim test As Integer
>
> strMain = ActiveSheet.Name
> i = 2
> For Each c In Range("a1:a60")
> strAddress = c.Address
> If Len(c.Value) = 0 Then
> MsgBox ("Finished")
> Exit Sub
> End If
>
> If InStr(1, c.Value, "Lead:") Then
> s = Trim(Right(c, Len(c) - 5))
> iloc = Instr(1,s,"/",vbTextcompare)
> if iloc <> 0 then
> s = Trim(Left(s,iloc-1))
> end if
> Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> sh.Name = s
> i = 2
> Else
> c.Resize(1, 5).Copy sh.Cells(i, "A")
> i = i + 1
> End If
> Next c
>
> End Sub


--

Dave Peterson
 
Reply With Quote
 
=?Utf-8?B?U2pha2tpZQ==?=
Guest
Posts: n/a
 
      24th Nov 2006
worked an absolute treat. Thanks.

One last question. with the code below,

If InStr(1, c.Value, "") Then
s = Trim(Left(c, Len(c) - 5))
iloc = InStr(1, s, "/", vbTextCompare)
If iloc <> 0 Then
s = Trim(Left(s, iloc - 2))
End If

Set sh = Nothing
On Error Resume Next
Set sh = Sheets(s)
On Error GoTo 0

'now check to see if that sheet didn't exist
If sh Is Nothing Then
'it doesn't exist, so add it
Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
sh.Name = s
Else
c.Resize(1, 15).Copy sh.Cells(i, "D")
i = i + 1

Which is from the code earlier in the script.
I have another Data dump which i have an option in row d. however with the
above code i end up with only the data ranging from D Till the 15th column
after that. Is there a was where i can tell it to also take the column A, B
and C with this.....



"Dave Peterson" wrote:

> Since you're adding sheets and renaming them immediately, you could just check
> to see if that worksheet name already exists. If it does, just skip it.
>
> This portion:
> Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> sh.Name = s
>
> Becomes:
> set sh = nothing
> on error resume next
> set sh = sheets(s)
> on error goto 0
>
> 'now check to see if that sheet didn't exist
> if sh is nothing then
> 'it doesn't exist, so add it
> Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> sh.Name = s
> end if
>
>
>
>
> Sjakkie wrote:
> >
> > How do i change the script below to go through the list and have the
> > duplicates searched aswell but only
> > allow the name to be used once.
> >
> > so that if there is
> >
> > lead 1
> > lead 2
> > lead 3
> > lead 4
> > lead 4
> > lead 5
> > lead 6
> > lead 4
> >
> > That it just makes the Worksheets
> > lead 1
> > lead 2
> > lead 3
> > lead 4
> > lead 5
> > lead 6
> >
> > Sub SplitDump()
> >
> > Dim sh As Worksheet, s As String
> > Dim i As Long, iloc as Long
> > Dim c As Range
> > Dim strAddress As String
> > Dim test As Integer
> >
> > strMain = ActiveSheet.Name
> > i = 2
> > For Each c In Range("a1:a60")
> > strAddress = c.Address
> > If Len(c.Value) = 0 Then
> > MsgBox ("Finished")
> > Exit Sub
> > End If
> >
> > If InStr(1, c.Value, "Lead:") Then
> > s = Trim(Right(c, Len(c) - 5))
> > iloc = Instr(1,s,"/",vbTextcompare)
> > if iloc <> 0 then
> > s = Trim(Left(s,iloc-1))
> > end if
> > Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> > sh.Name = s
> > i = 2
> > Else
> > c.Resize(1, 5).Copy sh.Cells(i, "A")
> > i = i + 1
> > End If
> > Next c
> >
> > End Sub

>
> --
>
> Dave Peterson
>

 
Reply With Quote
 
=?Utf-8?B?U2pha2tpZQ==?=
Guest
Posts: n/a
 
      24th Nov 2006
Got it

c.Resize(1, 20).Offset(, -3).Copy sh.Cells(i, "a")
i = i + 1

"Sjakkie" wrote:

> worked an absolute treat. Thanks.
>
> One last question. with the code below,
>
> If InStr(1, c.Value, "") Then
> s = Trim(Left(c, Len(c) - 5))
> iloc = InStr(1, s, "/", vbTextCompare)
> If iloc <> 0 Then
> s = Trim(Left(s, iloc - 2))
> End If
>
> Set sh = Nothing
> On Error Resume Next
> Set sh = Sheets(s)
> On Error GoTo 0
>
> 'now check to see if that sheet didn't exist
> If sh Is Nothing Then
> 'it doesn't exist, so add it
> Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> sh.Name = s
> Else
> c.Resize(1, 15).Copy sh.Cells(i, "D")
> i = i + 1
>
> Which is from the code earlier in the script.
> I have another Data dump which i have an option in row d. however with the
> above code i end up with only the data ranging from D Till the 15th column
> after that. Is there a was where i can tell it to also take the column A, B
> and C with this.....
>
>
>
> "Dave Peterson" wrote:
>
> > Since you're adding sheets and renaming them immediately, you could just check
> > to see if that worksheet name already exists. If it does, just skip it.
> >
> > This portion:
> > Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> > sh.Name = s
> >
> > Becomes:
> > set sh = nothing
> > on error resume next
> > set sh = sheets(s)
> > on error goto 0
> >
> > 'now check to see if that sheet didn't exist
> > if sh is nothing then
> > 'it doesn't exist, so add it
> > Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> > sh.Name = s
> > end if
> >
> >
> >
> >
> > Sjakkie wrote:
> > >
> > > How do i change the script below to go through the list and have the
> > > duplicates searched aswell but only
> > > allow the name to be used once.
> > >
> > > so that if there is
> > >
> > > lead 1
> > > lead 2
> > > lead 3
> > > lead 4
> > > lead 4
> > > lead 5
> > > lead 6
> > > lead 4
> > >
> > > That it just makes the Worksheets
> > > lead 1
> > > lead 2
> > > lead 3
> > > lead 4
> > > lead 5
> > > lead 6
> > >
> > > Sub SplitDump()
> > >
> > > Dim sh As Worksheet, s As String
> > > Dim i As Long, iloc as Long
> > > Dim c As Range
> > > Dim strAddress As String
> > > Dim test As Integer
> > >
> > > strMain = ActiveSheet.Name
> > > i = 2
> > > For Each c In Range("a1:a60")
> > > strAddress = c.Address
> > > If Len(c.Value) = 0 Then
> > > MsgBox ("Finished")
> > > Exit Sub
> > > End If
> > >
> > > If InStr(1, c.Value, "Lead:") Then
> > > s = Trim(Right(c, Len(c) - 5))
> > > iloc = Instr(1,s,"/",vbTextcompare)
> > > if iloc <> 0 then
> > > s = Trim(Left(s,iloc-1))
> > > end if
> > > Set sh = Sheets.Add(After:=Sheets(Sheets.Count))
> > > sh.Name = s
> > > i = 2
> > > Else
> > > c.Resize(1, 5).Copy sh.Cells(i, "A")
> > > i = i + 1
> > > End If
> > > Next c
> > >
> > > End Sub

> >
> > --
> >
> > Dave Peterson
> >

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Create Workbooks and then create Worksheets within them K Microsoft Excel Programming 2 27th Jul 2009 09:10 AM
How use info in Excel shared worksheets to create new worksheets =?Utf-8?B?ZGtj?= Microsoft Excel Worksheet Functions 0 28th Jun 2007 08:36 PM
I want to create and name 365 worksheets... =?Utf-8?B?RHIuIERhcnJlbGw=?= Microsoft Excel Worksheet Functions 1 8th Dec 2005 01:00 PM
Create New Worksheets in VB bbrendan Microsoft Excel Programming 1 16th Jul 2004 12:11 AM
Using 2 worksheets to create a third aipmto Microsoft Excel Worksheet Functions 0 23rd Feb 2004 09:23 PM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 05:39 AM.