如何使用VBA在Excel中将后缀添加到特定数据

Question

I have maintained a worksheet which contains the parameters of a particular product.

Here when i click ADD button all the contents of the CONTROL POWER TRANSFORMERS should get copied and it should get pasted below.

Here i am successful in copying the entire product details and pasting below using the vba code as mentioned below:

Dim WbEPC As Workbook, _
WbCPT As Workbook, _
WsEPC As Worksheet, _
WsCPT As Worksheet, _
FirstAddress As String, _
WriteRow As Long, _
cF As Range, _
num As String

Set WbEPC = Workbooks("EPC 1.xlsm")
Set WbCPT = Workbooks("Control Power Transformers.xlsm")
Set WsEPC = WbEPC.Sheets("Sheet1")
Set WsCPT = WbCPT.Sheets("Sheet1")


Dim b As Object, RowNumber As Integer
Set b = ActiveSheet.Shapes("CommandButton21")
With b.TopLeftCell
    RowNumber = .Row
End With


 Rows(RowNumber + 1 & ":" & RowNumber + 1).Select
 Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

With WsEPC
.Activate
With .Range("A1:A10000")

Set cF = .Find(what:="CTPT", _
    lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

            num = cF.Address

            WsEPC.Range(cF.Offset(-1, 0), cF.Offset(3, 3).End(xlDown)).Copy

            WsEPC.Range("A" & RowNumber + 1).Select


                Selection.Insert Shift:=xlDown
                Application.CutCopyMode = False

    End With
 End With

 MsgBox " Successfully added the product to EPC"

The above code is successfully copying the above product details below as shown below

Here "CTPT1" is the unique product id given to the product CONTROL POWER TRANSFORMERS and the same id is copying when i click ADD, instead of copying CTPT1 as shown in the figure(A22) i want it to automatically make itself to "CTPT2" when Add button is clicked, like wise if the add button is again clicked it should become "CTPT3" and so on.

Can anyone tell me how to achieve this automatic generation of the unique id using excel VBA. Any help is Appreciated!

Answer 1

This should do the trick :

Dim WbEPC As Workbook, _
    WbCPT As Workbook, _
    WsEPC As Worksheet, _
    WsCPT As Worksheet, _
    StringToSearch As String, _
    ButtonRow As Long, _
    WriteRow As Long, _
    cF As Range


Set WbEPC = Workbooks("EPC 1.xlsm")
Set WbCPT = Workbooks("Control Power Transformers.xlsm")
Set WsEPC = WbEPC.Sheets("Sheet1")
Set WsCPT = WbCPT.Sheets("Sheet1")
StringToSearch = "CTPT"

With WsEPC
    .Activate
    ButtonRow = .Shapes("CommandButton21").TopLeftCell.Row
    .Rows(ButtonRow + 1 & ":" & ButtonRow + 1).Insert Shift:=xlDown, _
                                                    CopyOrigin:=xlFormatFromLeftOrAbove
    With .Columns(1)
        Set cF = .Find(what:=StringToSearch, _
                        lookat:=xlPart, _
                        searchorder:=xlByRows, _
                        searchdirection:=xlNext, _
                        MatchCase:=False, _
                        SearchFormat:=False)
        WsEPC.Range(cF.Offset(-1, 0), cF.Offset(3, 3).End(xlDown)).Copy
        WriteRow = WsEPC.Range("B" & WsEPC.Rows.Count).End(xlUp).Row + 2
        WsEPC.Range("A" & WriteRow).Insert Shift:=xlDown
        Application.CutCopyMode = False

        cF.Value = CStr(StringToSearch & CLng(Replace(cF.Value, StringToSearch, vbNullString)) + 1)
    End With
End With

MsgBox " Successfully added the product to EPC"