assign code in sequential format to a set of rows VBA

melvinkoshy

New Member
Joined
Dec 13, 2017
Messages
27
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


Code:
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
 

Some videos you may like

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

wideboydixon

Well-known Member
Joined
Jun 2, 2016
Messages
3,401
Give this a whizz:

Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,203
Office Version
  1. 365
Platform
  1. Windows
This needs to have a value in B1,which should initially be 0
Code:
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

New Member
Joined
Dec 13, 2017
Messages
27
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,203
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
Code:
NxtRw = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Offset(1).Row
or in WBD's code to
Code:
nextRow= Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Offset(1).Row
This will find the last used row regardless of column
 
Last edited:

melvinkoshy

New Member
Joined
Dec 13, 2017
Messages
27
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.
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,203
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback
 

Watch MrExcel Video

Forum statistics

Threads
1,123,156
Messages
5,600,040
Members
414,357
Latest member
Gemma_R

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top