autonumbering for multiple columns based on two cells

[Maklil]

Hi
I want autonumbering and increment in D6 based on match cell D2 with headers in G1:J1 , if they're matched , then should increment number in D6 based on the last row for cell in columns G or H or I or J depends on matching with D2 and after autonumbering and increment in D6 then should copy under last row for cell in column match header with D2 as I highlighted in CR1,CR2,CR2 sheets (theses just examples )
I put example when use SALES & PURCHASES in D2 and match with columns G or H and will autonumbering and increment in D6 and copy under last row for cell in column G or H as in CR1,CR2,CR2 but CANCEL sheet should delete autonumbering in D6 when clear D2 and delete under last row for cell in column G when press commandbutton1(this case depends on CR3 sheet as in example)
thanks

[JeteMc]

As far as populating cell D6 the following formula seems to work:

=IF(ISTEXT(D2),INDEX(G2:J35,AGGREGATE(14,6,(ROW(G2:J35)-ROW(G1))/(G1:J1=D2)/(G2:J35<>""),1),MATCH(D2,G1:J1,0)),"")

I can't help with the button, but hopefully someone else can.
Let us know if you have any questions.

[bebo021999]

Working with sheet "main" only
There are two cell D2 and D6
And the "Worksheet_change" event trigger those cells.
In D2: Pick item from Dropdown list. D6 and corresponding column G:J last row will generate new items with sequence number +1
In D6: Just Delete then the corresponding value in G:J will be deleted.

Option Explicit 
Private Sub Worksheet_Change(ByVal Target As Range) 
Dim pos&, LastCell As Range, oldV, f 
If Target.Address(0, 0) = "D2" And Not IsEmpty(Target) Then 
    pos = Evaluate("=match(D2,B2:B5,0)") 
    Set LastCell = Range("F1").Offset(, pos).End(xlDown) 
    Application.EnableEvents = False 
    Range("D6").Value = Left(LastCell, Len(LastCell) - 3) & Format(Right(LastCell, 3) + 1, "000") 
    Application.EnableEvents = True 
    LastCell.Offset(1, 0).Value = Range("D6").Value 
ElseIf Target.Address(0, 0) = "D6" Then 
    If IsEmpty(Target) Then 
        Application.Undo 
        oldV = Target 
        Set f = Range("G2:J100").Find(oldV) 
        If Not f Is Nothing Then f.ClearContents 
        Application.EnableEvents = False 
        Target.ClearContents 
        Application.EnableEvents = True 
    End If 
End If 
End Sub  

[jindon]

1) To a standard code module

Sub test()
    Dim x, s(1)
    With ActiveSheet
        .[d6].ClearContents
        If .[d2] = "" Then Exit Sub
        x = Application.Match(.[d2], .Rows(1), 0)
        s(0) = .Cells(Rows.Count, x).End(xlUp)
        s(1) = Format$(Val(Right$(s(0), 3)) + 1, "000")
        s(0) = Left(s(0), Len(s(0)) - 3)
        .[d6] = Join(s, "")
        .Cells(Rows.Count, x).End(xlUp)(2) = Join(s, "")
    End With
End Sub

2) Add Forms CommandButton, prefer on the worksheet rather than ActiveX object, in each sheet that you want the code to be executed.
Right click and assign "test" macro.

[Maklil]

I can't help with the button, but hopefully someone else can.

need vba . anyway thank you

[Maklil]

@bebo021999
fantastic !
many thanks for your help.

[Maklil]

@jindion
perfect but you forgot last case in CANCEL sheet .
when clear D2,D6 ,then should clear last cell in column have ever autonumbering .
example : D2=SALES , when run macro D6=SS NO: S001 , but if I come back to cancelling by clear D2,D6 , then will clear S001 from SALES column .

[jindon]

That's a really a stupid way.
Add CANCEL to the named range

Sub test()
    Dim x, s(1)
    With ActiveSheet
        If .[d2] = "" Then Exit Sub
        If .[d2] = "CANCEL" Then
            If .Name = "CANCEL" Then
                .Columns("g").Resize(, .Cells.SpecialCells(11).Column - 7).Replace .[d6], "", 1
                .[d6].ClearContents
            End If
        Else
            x = Application.Match(.[d2], .Rows(1), 0)
            s(0) = .Cells(Rows.Count, x).End(xlUp)
            s(1) = Format$(Val(Right$(s(0), 3)) + 1, "000")
            s(0) = Left(s(0), Len(s(0)) - 3)
            .[d6] = Join(s, "")
            .Cells(Rows.Count, x).End(xlUp)(2) = Join(s, "")
        End If
    End With
End Sub

[jindon]

Don't like this way though
1) No CANCEL in the list.
2) Change test sub to

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s
    If Target.Address(0, 0) <> "D6" Then Exit Sub
    Application.EnableEvents = False
    If Target.Value = "" Then
        Application.Undo
        s = [d6]
        Columns("g").Resize(, Cells.SpecialCells(11).Column - 6).Replace s, "", 1
        [d6].ClearContents
    End If
    Application.EnableEvents = True
End Sub

3) to CANCEL sheet code module

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim s
    If Target.Address(0, 0) <> "D6" Then Exit Sub
    Application.EnableEvents = False
    If Target.Value = "" Then
        Application.Undo
        s = [d6]
        Columns("g").Resize(, Cells.SpecialCells(11).Column - 6).Replace s, "", 1
        [d6].ClearContents
    End If
    Application.EnableEvents = True
End Sub

[Maklil]

sorry jindon !
procedure cancel should be in the MAIN sheet , not cancel sheet.
cancel sheet is just example .

[jindon]

Then use #9 and 3) to main sheet code module instead of CANCEL sheet.

[Maklil]

Then use #9 and 3) to main sheet code module instead of CANCEL sheet.

yes I will use #3 , but #9 doesn't help because the code doesn't work
thank you

[jindon]

Tested #9 and working here, so bad luck.

[Maklil]

so bad luck.

no !
I understood this

2) Change test sub to

delete test sub . I expect the code in post#9 will do any thing without depend on test sub

so with two procedures the code works perfectly .
many thanks for your time & help .