Macro question - insert new tabs and copy across for new vendor

[richardjshaffer]

Hi,

I'm hoping someone might be able to help with this query - what we'd like to do is have a new worksheet created for any new vendor which might be typed in to the frontsheet.

For example on the front sheet -

<TABLE style="WIDTH: 152pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=203 border=0><COLGROUP><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 56pt; mso-width-source: userset; mso-width-alt: 2742" width=75><COL style="WIDTH: 48pt" width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 48pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" width=64 height=20>Vendor</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 56pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=75>Date</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 48pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=64>Amount</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>g76</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>01/04/2011</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>34</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>g77</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>01/04/2011</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>554</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>g76</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>02/05/2011</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>356</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>g76</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>01/03/2011</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>234</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>g80</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>01/03/2011</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>6534</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>g81</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>01/03/2011</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>56</TD></TR></TBODY></TABLE>

So we key in g81 (a new, unique vendor) on the next available line, so what we need is for the macro to recognise that it's a new vendor, create a brand new worksheet, and copy across the associated data onto that sheet ie
<TABLE style="WIDTH: 152pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=203 border=0><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>g81</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>01/03/2011</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>56</TD></TR></TBODY></TABLE>

Hope this is clear, please can someone help?

thanks,

Richard

 

[Domenic]

I'm not sure that this is exactly what you're looking for, but maybe something like this...

Assumptions:

1) Columns A through C contain the data

2) Row 1 contains the column headers

3) The data starts at Row 2

Macro:

Place the following code in the sheet module for the sheet containing the data (right-click the sheet tab and select 'View Code')...

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_Change([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range)
    [color=darkblue]If[/color] Target.Cells.Count > 1 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]If[/color] Intersect(Range("A:C"), Target) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=darkblue]Dim[/color] wksDest [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] TargetRng [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]With[/color] Me.UsedRange
        LastRow = .Rows.Count + .Rows(1).Row - 1
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]Set[/color] TargetRng = Range(Cells(Target.Row, "A"), Cells(Target.Row, "C"))
    [color=darkblue]If[/color] WorksheetFunction.CountA(TargetRng) = 3 [color=darkblue]Then[/color]
        [color=darkblue]If[/color] WorksheetFunction.CountIf(Range("A2", Cells(LastRow, "A")), Cells(Target.Row, "A")) = 1 [color=darkblue]Then[/color]
            [color=darkblue]Set[/color] wksDest = Worksheets.Add(after:=Worksheets(Worksheets.Count))
            wksDest.Name = Cells(Target.Row, "A")
            TargetRng.Copy Destination:=wksDest.Cells(wksDest.Rows.Count, "A").End(xlUp)(2)
            Me.Activate
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
End [color=darkblue]Sub[/color]
[/font]

Note that only when all three columns have data and the vendor is unique will a new sheet be created for that vendor and the data copied to that vendor's sheet.

If the data needs to be copied to its respective worksheet when the Vendor is not unique and and a worksheet already exists, the macro will need to be amended.

 

[richardjshaffer]

Thanks for your reply, though I'm struggling to run it - I'm more familiar with recording a macro, then stepping into it to paste the code we want - though if I do this it returns an error, is the code exactly what I need?

thanks

 

[Domenic]

Can you please specify which error you get and which line gets highlighted?

 

[richardjshaffer]

Hi,

I get "invalid inside procedure" at the Option Explicit line, however even taking this line out gives an error too?

thanks - thinking might be easier if you could send me a simple workbook by email with the example which works? (richardjshaffer@hotmail.com)

regards and many thanks

 

[Domenic]

I get "invalid inside procedure" at the Option Explicit line, however even taking this line out gives an error too?

Which error do you now get?

Which line now gets highlighted?

Also, what if a vendor already exists? Do you want to copy the data to an existing worksheeet?

 

[richardjshaffer]

thanks for your help, however I found some similiar code which seems to work:

Sub vendors_newsheet()
Dim sh As Worksheet, rws&, cls&
Dim g As Range, e As Range
Set sh = ActiveSheet
Sheets.Add.Name = "tmp"
sh.Activate
rws = Cells.Find("*", after:=[A1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
cls = Cells.Find("*", after:=[A1], searchorder:=xlByColumns, _
searchdirection:=xlPrevious).Column
With Sheets("tmp")
sh.Range("A1").Resize(rws, cls).Copy .Range("A1")
.Activate
.Range("A1").Resize(rws, cls).Sort .Range("A1"), 1, Header:=xlYes
Set g = .Range("A2")
For Each e In Range(g, g.End(4)(2))
If e <> g Then
Sheets.Add.Name = g.Value
Range(g, e(0)).Resize(, cls).Copy Sheets(g.Value).Range("A1")
Set g = e
End If
Next e
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub

thanks again, if I need anything else I'll ask if that OK, kind regards.

 

[Domenic]

Glad you've found what you're looking for, and thanks for the feedback!