assign code in sequential format to a set of rows VBA

[melvinkoshy]

I have a DBFORMAT sheet where there are 6 types of DBs (Distribution boards) differentiated by headings in rows. There is an RADB sheet with a dropdown menu and “ADD” button. When I select the DB from dropdown menu and press ADD, the corresponding rows of item from the DBFORMAT is copied and pasted in the OUTPUT sheet.


I used the following code for copying which is working correctly

Private Sub CommandButton1_Click()
    If Worksheets("RADB").Range("E1") = "TPN" Then
        Worksheets("DBFORMAT").Range("A2:M13").Copy
        Worksheets("RADB").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
         
    If Worksheets("RADB").Range("E1") = "VTPNRCBO" Then
       Worksheets("DBFORMAT").Range("A15:M26").Copy
        Worksheets("RADB").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
   
     If Worksheets("RADB").Range("E1") = "VTPNMCCB" Then
       Worksheets("DBFORMAT").Range("A28:M40").Copy
        Worksheets("RADB").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
   
    If Worksheets("RADB").Range("E1") = "PSDB" Then
       Worksheets("DBFORMAT").Range("A42:M54").Copy
        Worksheets("RADB").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
   
     If Worksheets("RADB").Range("E1") = "FLEXY" Then
       Worksheets("DBFORMAT").Range("A56:M67").Copy
        Worksheets("RADB").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
 
    If Worksheets("RADB").Range("E1") = "SPN" Then
       Worksheets("DBFORMAT").Range("A69:M80").Copy
        Worksheets("RADB").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial
    End If
End Sub

When I click ADD button, I wish to number the DBs automatically in the RADB sheet in the format DB1, DB2, DB3 and so on. The DB number should appear in Col. B of RADB sheet and immediate left to the title of the respective DB.


What is the code that has to be added to the above code for achieving the numbering to be used for the same? screenshot indicating the desired numbering is marked as red circles in the image attached.


Image file: http://s000.tinyupload.com/?file_id=02202116074460927041

Excel file: http://s000.tinyupload.com/?file_id=60065120454233364376

 

[wideboydixon]

Give this a whizz:

Private Sub CommandButton1_Click()

    Dim sourceRange As Range
    Dim nextRow As Long
    
    nextRow = Worksheets("RADB").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
    
    With Worksheets("DBFORMAT")
        Select Case Worksheets("RADB").Range("E1").Value
            Case "TPN"
                Set sourceRange = .Range("A2:M13")
            Case "VTPNRCBO"
                Set sourceRange = .Range("A15:M26")
            Case "VTPNMCCB"
                Set sourceRange = .Range("A28:M40")
            Case "PSDB"
                Set sourceRange = .Range("A42:M54")
            Case "FLEXY"
                Set sourceRange = .Range("A56:M67")
            Case "SPN"
                Set sourceRange = .Range("A69:M80")
        End Select
    End With
    
    If Not sourceRange Is Nothing Then
        sourceRange.Copy
        With Worksheets("RADB")
            .Cells(nextRow, 1).PasteSpecial
            .Cells(nextRow, 2).Value = "DB" & CStr(Application.WorksheetFunction.CountA(.Range("B:B")) + 1)
        End With
    End If
        
End Sub

WBD

 

[Fluff]

This needs to have a value in B1,which should initially be 0

Private Sub CommandButton1_Click()
   
   Dim NxtRw As Long
   
   NxtRw = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
   Range("B1").Value = Range("B1").Value + 1
   
   With Worksheets("DBFORMAT")
      Select Case Range("E1")
         Case "TPN"
            .Range("A2:M13").Copy Range("A" & NxtRw)
            Range("B" & NxtRw).Value = "DB" & Range("B1")
         Case "VTPNRCBO"
            .Range("A15:M26").Copy Range("A" & NxtRw)
            Range("B" & NxtRw).Value = "DB" & Range("B1")
         Case "VTPNMCCB"
            .Range("A28:M40").Copy Range("A" & NxtRw)
            Range("B" & NxtRw).Value = "DB" & Range("B1")
         Case "PSDB"
            .Range("A42:M54").Copy Range("A" & NxtRw)
            Range("B" & NxtRw).Value = "DB" & Range("B1")
         Case "FLEXY"
            .Range("A56:M67").Copy Range("A" & NxtRw)
            Range("B" & NxtRw).Value = "DB" & Range("B1")
         Case "SPN"
            .Range("A69:M80").Copy Range("A" & NxtRw)
            Range("B" & NxtRw).Value = "DB" & Range("B1")
      End Select
   End With
End Sub

I've also slimmed down your code slightly.

 

[melvinkoshy]

Both the code given by @wideboynixon and @Fluff works great.

Few clarifications are required : -

1. In my code, after clicking ADD button, there used to be marching ants around the corresponding range in the DBFORMAT sheet. What was the reason for it? In the code given by both of you, it is not present. Could you help me understand the reason?

2. In my code, I did not know how to find out the next blank row. Hence, I populated Col. A in DBFORMAT sheet with corresponding DB names till the last row of that particular type of DB so that on next click of ADD, the item would appear below this.

I wish to avoid the text in Col. A of DBFORMAT sheet altogether. But, after I delete the DB names in Col. A of DBFORMAT sheet, while clicking subsequent DBs in RADB sheet, the data gets written on top of the first item added to the RADB sheet.

How to tweak the code such that in RADB sheet, the next item would be pasted in the next empty cell, which will be found out by scanning columns and rows.

Image of a DB in DB format sheet wherein Col. A is populated with DB name is included in this link http://s000.tinyupload.com/?file_id=03110832693474556654

 

[Fluff]

1) You got the "marching ants" as you were copying & pasting the data ( I got the same result with the code by WBD). Whereas I was copying the data direct (rather than via the clipboard).
2) Change the NxtRw in my code to

NxtRw = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Offset(1).Row

or in WBD's code to

nextRow= Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Offset(1).Row

This will find the last used row regardless of column

 

[melvinkoshy]

Yes @Fluff, it works great! In fact, I required the serial no. to appear in the next row. I modified the code and tested it and it works as desired.

 

[Fluff]

Glad we could help & thanks for the feedback