Copy a row per the QTY Value

Evapar18

Board Regular
Joined
Aug 3, 2018
Messages
86
Office Version
  1. 2019
Platform
  1. Windows
So I am trying to do this code at the end of the "Button click". If the QTY.value is > 1 then I need it to copy the data that has already been inputted in the spreadsheet = to the X QTY.

If possible I would like the Dimension# stay put and no changes to it.

https://goo.gl/HWRn9T

Per the image, I just want to copy Range B through G per the QTY, minus the first one, so 3 more times. other than the "If" statement above that's is as far as I got. I searched the web found a few selections but nothing I found worked exactly the way I was needing.

I plan to clear all the values after this and add more dimensions.

Thanks,
SB
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Maybe something like
Code:
Range("B3:G3").Copy Range("B4:G4").Resize(1 * (Range("H3") - 1))
 
Upvote 0
Thanks that's closer than what I had, but I keep getting a Runtime error 1004.

I guess I should have pointed out is that the row is dynamic and changing per each dimension that is added. So it's not in a dedicated cell every time.
 
Upvote 0
What code are you using to add the details to the row?
 
Upvote 0
It's not written very well, but it works except for this part.

Code:
Private Sub Add_Dim_Click()

dst = DSub.Value
n = Nominal.Value
u = Units
q = QTY


Dim rw As Long 'next available row


If TextBox1.Enabled And TextBox2.Enabled Then


    With Sheets("Sheet1")
    
    rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
    
    .Range("C" & rw) = n
    .Range("Q" & rw) = TextBox1 'Max Tolerance
    .Range("P" & rw) = TextBox2 'Min Tolerance
    .Range("E" & rw).FormulaR1C1 = "=RC[-2]-RC[11]" 'Min Tolerance
    .Range("F" & rw).FormulaR1C1 = "=RC[-3]+RC[11]" 'Max Tolerance
    
    
    End With
    
ElseIf TextBox3 = Enabled And TextBox4 = Enabled Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("C" & rw) = n
        .Range("F" & rw) = TextBox4
        .Range("E" & rw) = TextBox3
    
        End With
 
ElseIf Sym = Enabled And StdT = "ANGULAR" Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("C" & rw) = n
        .Range("D" & rw).Value = Sym
        .Range("F" & rw).FormulaR1C1 = "=RC[-3]+RC[-2]" 'Min Tolerance
        .Range("E" & rw).FormulaR1C1 = "=RC[-2]-RC[-1]" 'Max Tolerance
        
         End With


ElseIf Sym = Enabled And StdT = "2 PLC DEC" Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("C" & rw) = n
        .Range("D" & rw).Value = Sym
       
        
         End With


ElseIf Sym = Enabled And StdT = "3 PLC DEC" Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("C" & rw) = n
        .Range("D" & rw).Value = Sym
        
         End With
         
         
ElseIf Sym = Enabled Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        
        .Range("C" & rw) = n
        .Range("D" & rw) = Sym
        
         End With


ElseIf DSub = "Text" Then
    
        With Sheets("Sheet1")
    
        rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
    
        .Range("C" & rw) = n
        
         End With


End If
 
   With Sheets("Sheet1")
 
      'get the next avialable row in Sheet1
      rw = .Range("B" & .Rows.Count).End(xlUp).Row + 1
 
      'put the text box values in this row
      .Range("B" & rw) = dst
      '.Range("C" & rw) = n
      .Range("G" & rw) = u
      .Range("H" & rw) = q
      
      
   
   End With
 


       If QTY.Value > 1 Then
 
             Range("B3:G3").Copy Range("B4:G4").Resize(1 * (Range("H3") - 1))
 
 
 
        End If




   '================================
   'OPTIONAL - clear the text boxes
   '================================
   DSub.Value = ""
   Nominal.Value = ""
   Tol_type.Value = ""
   TextBox1.Value = ""
   TextBox2.Value = ""
   TextBox3.Value = ""
   TextBox4.Value = ""
   Sym.Value = ""
   StdT.Value = ""
   
   'QTY.Value = ""
   
  
End Sub
 
Upvote 0
Ok, try
Code:
If Qty.Value > 1 Then
   With Sheets("sheet1")
      .Range("B" & Rw).Resize(, 6).Copy Range("B" & Rw + 1).Resize(1 * (CLng(Qty) - 1), 6)
   End With
End If
 
Upvote 0
That works perfectly! Thanks so much, I truly appreciate it.

May God Bless you!
SB
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,213,532
Messages
6,114,177
Members
448,554
Latest member
Gleisner2

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
Back
Top