VBA/Macro for Copying Purchase Order Form to a New Tab, Auto Increment the Tab number.

[joemi]

Hello All,
I normally find your form very informational, so I thought I would try to get any answer.
I have a form that has a bunch of worksheets with a Purchase ORder form on each sheet. The sheets are label 001-100. I also have a "PO Tracker" Sheet, that basically takes information from from each Purchase order form and organizes it on the tracker (IE; PO #, Date of Purchase, Vendor, and Customer Sold to). I have also created a Hyperlink from the Tracker sheet to each individual Purchase order form, for quickly finding a given PO. The problem that I have is that once I exceed the 100, I have to manually copy a new PO form to a new tab, rename it to "101", and then on the Tracker sheet, I have to create new line items with links to the appropriate fields.
It can be time consuming when you are doing this everyday.
Is there a way I can create a macro to Automatically copy the blank PO form, Create and Name Incrementally (101,102,etc.) and then also add a line item to tracker with all of the look ups to the new tabs created?
I have tested a few codes in VBA, but can't quite get it right.
This would be a huge time saver, as well as make it so any of my co-workers could create their own new PO's without ruining the Workbook.
Thanks in advance.

[mehmetcik]

Interesting.


But I don't like the layout of your summary sheet.

I'll create something for you.

Will take a while.

[joemi]

PMmehmetcik,
Thank you for your support. The layout of the summary isn't too important, as long as the permanent data is captured. I look forward to se what you come up with.

[mehmetcik]

Ok Try this.

I used two macros and a Userform

One Macro is in a normal module and is called auto open so it will run as soon as you open the workbook:-

Sub Auto_Open()
    Sheets("PO Tracker").Select
    UserForm1.Show vbModeless
End Sub

The Second Macro is in the "This Workbook" macro Module it simply runs Auto Open if you double click anywhere in the workbook.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Auto_Open
End Sub

The Userform:-

Private Sub ComboBox1_Change()
'Run the Search Text Subroutine
SearchText
End Sub

Private Sub ComboBox2_Change()
'Run the Search Text Subroutine
SearchText
End Sub

Private Sub CommandButton1_Click()
'Create New Entry

'Quit if either combobox is empty
If ComboBox1.Value = "" Or ComboBox2.Value = "" Then Exit Sub

'Find Row where the new PO data needs to be stored on Summary Sheet
NR = Cells(Rows.Count, 5).End(xlUp).Row + 1

'Find The next po No
PoNo = Application.Max(Range("B17:B" & NR).Value)

'Save the PO Data
Cells(NR, 2).Value = PoNo
Cells(NR, 3).Value = Format(Now, "dd/mm/yyyy")
Cells(NR, 4).Value = ComboBox1.Value
Cells(NR, 5).Value = ComboBox2.Value

'Create the new PO
Sheets("Master").Copy Before:=Sheets("Temp Area")
ActiveSheet.Name = "PO " & NR
Unload Me
End Sub

Private Sub ListBox1_Click()

'Go To The Selected PO
On Error Resume Next
Sheets("PO " & ListBox1.Value).Select
Unload Me
On Error GoTo 0
End Sub

Private Sub UserForm_Activate()

'Load The Comboboxes using the sorted Unique Lists of Customers and Vendors.

'I used two dynamic ranges and two Array formulae to create and sort the unique lists.
'Use the name manager to see the Dynamic Names

Dim myshts, i As Integer
vendors = Cells(Rows.Count, 7).End(xlUp).Row
CkV: If Cells(vendors, 7) = "" Then vendors = vendors - 1: GoTo CkV
ComboBox1.List = Range(Cells(2, 7), Cells(vendors, 7)).Value
ComboBox1.ListIndex = 0

customers = Cells(Rows.Count, 8).End(xlUp).Row
CkC: If Cells(customers, 8) = "" Then customers = customers - 1: GoTo CkC
ComboBox2.List = Range(Cells(2, 8), Cells(customers, 8)).Value
ComboBox2.ListIndex = 0

ListBox1.Clear
      
End Sub

Private Sub SearchText()
Dim UniqueItem As Collection

If ComboBox1.Value & ComboBox2.Value = "" Then Exit Sub

LR = Cells(Rows.Count, 5).End(xlUp).Row

'We find the longest text in the comboboxes and search for that
TextLen = 0

For Count = 1 To 2
If Len(Me.Controls("Combobox" & Count).Value) > TextLen Then
TextLen = Len(Me.Controls("Combobox" & Count).Value)
strValueToPick = Me.Controls("Combobox" & Count).Value
End If
Next


'This is were we search
'This is a Looping Find to find all appearances of our text
'We create a new range by adding the addresses of cells containing the text togeather

On Error Resume Next

    With Range("D17:E" & LR)
        Set rngFind = .Find(strValueToPick, .Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstAddress = rngFind.Address
            Set rngPicked = rngFind
            Do
                Set rngPicked = Union(rngPicked, rngFind)
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstAddress
        End If
    End With
    
    If strFirstAddress = "" Then Exit Sub

'We select all those cells
rngPicked.Select


ListBox1.Clear

Set UniqueItem = New Collection
'In your test data you could use A as your supplier ana as your vendor
'That PO would be listed twice.  So we use a collection to get rid of dulicates

'Find Matches
'We check that our data matches Combobox1 and Combobox2
For Each c In Selection
RowText = Join(Application.Transpose(Application.Transpose(Range(Cells(c.Row, 1), Cells(c.Row, 6)).Value)), " ")
If Len(ComboBox1.Text) > 0 And InStr(LCase(RowText), Trim(LCase(ComboBox1.Text))) = 0 Then GoTo 10
If Len(ComboBox2.Text) > 0 And InStr(LCase(RowText), Trim(LCase(ComboBox2.Text))) = 0 Then GoTo 10


'Remove Duplicates
'We simply store the row numbers of our celected cells in a collection
'If you store the same row number twice then one gets over written
'With out the On Error Resume next we would get an error message "Entry Exists or similar"
'We surpress the message ad ditch the duplicate
On Error Resume Next
temp = c.Row
UniqueItem.Add CStr(c.Row), CStr(c.Row)
On Error GoTo 0
10 Next c


'Copy Valid Data to Temp Area

Pos = 2
For N = 1 To UniqueItem.Count
Range("B" & UniqueItem(N) & ":E" & UniqueItem(N)).Copy Destination:=Sheets("Temp Area").Cells(Pos, 1)
Pos = Pos + 1
Next

Application.ScreenUpdating = False

'We Sort because Our Data is read out of the collection in reverse order
'So our data ends up reversed

Sheets("Temp Area").Select
    ActiveWorkbook.Worksheets("Temp Area").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Temp Area").Sort.SortFields.Add Key:=Range("A2:A" & Pos _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Temp Area").Sort
        .SetRange Range("A1:E" & Pos)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

ListBox1.RowSource = "A2:D" & Pos - 1

i = ListBox1.ListCount + 4
UserForm1.Height = (i + 3) * 12
ListBox1.Height = Application.Min(Application.Max(i * 10, 120), 480)
      
Sheets("PO Tracker").Select
Application.ScreenUpdating = True

End Sub

I used two Dynamic ranges. Look in the name manager

One of them is the customer names cc

='PO Tracker'!$E$17:INDEX('PO Tracker'!$E$17:$E$1996,MATCH(REPT("z",255),'PO Tracker'!$E$17:$E$1996))

That works with an array formula to create a sorted unique list of customers for Combobox1.

{=IF(AND(D$18="",ROW()=2),D$17,IFERROR(INDEX(vv,MATCH(0,COUNTIF(vv,"<"&vv)-SUM(COUNTIF(vv,G$1:G2)),0)),""))}

Ok Enjoy.

[joemi]

Awesome! I can't believe you did it so fast.
I only have a few small questions or tweaks.
1. It seems to always start the PO number at 17.
2. We use a specific number system -"5 digit job number" - "3 digit PO": 12345-001. So I only need the tab to read 001, 002, etc. instead of PO17
3. I don't understand what the green fields are for on the Tracker sheet.
4. It would be awesome if when the new PO form was created, it would auto populate the PO form with the Vendor Name (located in Cell D:13) and the Customer Name (in Cell D:20) of the New PO form that was created.
5. Lastly, I would prefer to not have the form pop up on start up. I think I have figured it out, but I didn't want to break your work...

But this could save a ton of time. Thank You Again.

[mehmetcik]

Try this version.

The Green areas are the sorted list of vendors and customers from your data.

These lists are used to populate the Combo Boxes

[joemi]

Thanks again. That fixed some of it. I still notice that PO's are starting at 17.
I have attached a copy with some changes I have made...of course I broke things.
I also changed the summary sheet to look a little different.
I think it is really close.
I really appreciate your help on this.

[mehmetcik]

Try This Version

[joemi]

Awesome! I am noticing a couple of strange things:
1. When I clear things out to start from number 1, I can enter the first PO perfectly. But when I try to create a second one, I get an error that asks me to debug.
2. For some reason the date field is not working. It keeps putting in a specific date, and not the one entered in the PO form.
3. On the temp data sheet, it keeps copying the top row from the PO tracker sheet.

I have tried messing with a few things in your code line, but I keep screwing it up. I thought I was smart, but you have shown me I still have a lot to learn.
Thank You again for spending time on this. It is very much appreciated.

P.S. I have attached the form as I have edited it, to start from the beginning, by deleting the existing PO's and data entered. The VBA code is untouched from your last version.