Copy and insert 22 lines below and change value

T

Tixevil

New Member
Joined
Jan 3, 2017
Messages
2
Hi I am looking for a solution, once criteria is met ---If Cells(Row, "d") = "1" And Cells(Row, "e") = "6" (change the value on that row)
Then Cells(Row, "f").Value = "U"
copy and insert 22 duplicate lines of the met criteria row and then change the cell .value in column "F" in each of the new rows. i am pretty new to VBA so any help would be much appreciated. i can get it to copy 22 lines its not knowing where to start with the code to change the values of the copies. So for example, i have a questionnaire with 10 Answers, upon meeting criteria in 2 cells, this answer needs copying and inserting 22 times below this answer. Then if the answer in column "F" is 1, i need to change the the new inserted lines (column "F") to 2, 3, 4, n, u, etc. Then i need this to loop through around 2000 questions until its completed it.

I would appreciate you help on this greatly.
Code: 
Public Sub CopyData()
    ' This routing will copy rows based on the quantity to a new sheet.
    Dim rngSinglecell As Range
    Dim rngQuantityCells As Range
    Dim intCount As Integer
Dim LastRow As String
Dim Row As Double


LastRow = Range("D" & Rows.Count).End(xlUp).Row


For Row = 2 To LastRow
Sheets("Sheet1").Activate
' Answer code is "U" answer text is "Redact"
If Cells(Row, "d") = "1" And Cells(Row, "e") = "6" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "1" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "2" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "5" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "6" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "7" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "8" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "9" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "10" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "11" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "12" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "14" Then
Cells(Row, "f").Value = "U"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "16" Then
Cells(Row, "f").Value = "U"
End If
'- answer code is "1" answer text is "-"
If Cells(Row, "d") = "1" And Cells(Row, "e") = "12" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "1" And Cells(Row, "e") = "12" And Cells(Row, "f") = "1" Then
Cells(Row, "g").Value = "-"
End If
If Cells(Row, "d") = "1" And Cells(Row, "e") = "13" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "1" And Cells(Row, "e") = "13" And Cells(Row, "f") = "1" Then
Cells(Row, "g").Value = "-"
End If
If Cells(Row, "d") = "11" And Cells(Row, "e") = "4" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "11" And Cells(Row, "e") = "4" And Cells(Row, "f") = "1" Then
Cells(Row, "g").Value = "-"
End If
If Cells(Row, "d") = "11" And Cells(Row, "e") = "5" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "11" And Cells(Row, "e") = "5" And Cells(Row, "f") = "1" Then
Cells(Row, "g").Value = "-"
End If
' answer code is "100" answer text is "s" note upper case lettering on answer text 
If Cells(Row, "d") = "3" And Cells(Row, "e") = "29" Then
Cells(Row, "f").Value = "100"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "29" And Cells(Row, "f") = "100" Then
Cells(Row, "g").Value = "s"
End If


' Answer code is "5" answer text is "Occupier declianed all Services" note uppercase lettering on answer text as must mach CFRMIS
If Cells(Row, "d") = "3" And Cells(Row, "e") = "18" Then
Cells(Row, "f").Value = "5"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "18" And Cells(Row, "f") = "5" Then
Cells(Row, "g").Value = "s"
End If


' Answer code is "" answer text is "" this should apply blanks to both fields
If Cells(Row, "d") = "3" And Cells(Row, "e") = "3" Then
Cells(Row, "f").Value = ""
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "3" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "4" Then
Cells(Row, "f").Value = ""
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "4" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "15" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "15" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "17" Then
Cells(Row, "f").Value = ""
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "17" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "19" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "19" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "20" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "20" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "01/01/0001"
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "25" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "25" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "0"
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "30" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "30" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "01/01/0001"
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "41" Then
Cells(Row, "f").Value = "0"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "41" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "42" Then
Cells(Row, "f").Value = "0"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "42" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "43" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "43" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "54" Then
Cells(Row, "f").Value = "0"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "54" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "55" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "55" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "56" Then
Cells(Row, "f").Value = "0"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "56" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "57" Then
Cells(Row, "f").Value = "0"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "57" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "58" Then
Cells(Row, "f").Value = "0"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "58" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "59" Then
Cells(Row, "f").Value = "0"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "59" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "60" Then
Cells(Row, "f").Value = "0"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "60" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "63" Then
Cells(Row, "f").Value = "0"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "63" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "64" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "64" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "74" Then
Cells(Row, "f").Value = "n"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "74" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "75" Then
Cells(Row, "f").Value = "7"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "75" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "3" And Cells(Row, "e") = "76" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "3" And Cells(Row, "e") = "76" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


' section 4
If Cells(Row, "d") = "4" And Cells(Row, "e") = "3" Then
Cells(Row, "f").Value = "0"
End If
If Cells(Row, "d") = "4" And Cells(Row, "e") = "3" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "4" And Cells(Row, "e") = "5" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "4" And Cells(Row, "e") = "5" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


' section 5
If Cells(Row, "d") = "5" And Cells(Row, "e") = "6" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "5" And Cells(Row, "e") = "6" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


If Cells(Row, "d") = "5" And Cells(Row, "e") = "9" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "5" And Cells(Row, "e") = "9" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


If Cells(Row, "d") = "5" And Cells(Row, "e") = "11" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "5" And Cells(Row, "e") = "11" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


' section 6




If Cells(Row, "d") = "6" And Cells(Row, "e") = "9" Then
Cells(Row, "f").Value = ""
End If
If Cells(Row, "d") = "6" And Cells(Row, "e") = "9" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If


If Cells(Row, "d") = "6" And Cells(Row, "e") = "10" Then
Cells(Row, "f").Value = "1"
End If
If Cells(Row, "d") = "6" And Cells(Row, "e") = "10" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = "-"
End If


' section 7
If Cells(Row, "d") = "7" And Cells(Row, "e") = "2" Then
Cells(Row, "f").Value = "2"
End If
If Cells(Row, "d") = "7" And Cells(Row, "e") = "2" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If
If Cells(Row, "d") = "7" And Cells(Row, "e") = "1" Then
Cells(Row, "f").Value = "2"
End If
If Cells(Row, "d") = "7" And Cells(Row, "e") = "1" And Cells(Row, "f") = "2" Then
Cells(Row, "g").Value = "No"
End If
'This is to apply redact to all fields that have a u against them
If Cells(Row, "f") = "U" Then
Cells(Row, "G").Value = "Redact"


' duplication event
If Cells(Row, "d") = "6" And Cells(Row, "e") = "8" Then
Cells(Row, "f").Value = ""
End If
If Cells(Row, "d") = "6" And Cells(Row, "e") = "8" And Cells(Row, "f") = "" Then
Cells(Row, "g").Value = ""
End If
End If
Next




    ' Set this for the range where the Quantity column exists. This works only if there are no empty cells
    Set rngQuantityCells = Range("i2", Range("i2").End(xlDown))


    For Each rngSinglecell In rngQuantityCells
        ' Check if this cell actually contains a number
        If IsNumeric(rngSinglecell.Value) Then
            ' Check if the number is greater than 0
            If rngSinglecell.Value > 0 Then
                ' Copy this row as many times as .value
                For intCount = 1 To rngSinglecell.Value
                    ' Copy the row into the next emtpy row in sheet2
                    Range(rngSinglecell.Address).EntireRow.Copy Destination:=Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    ' The above line finds the next empty row.




                Next
            End If
        End If
    Next
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
You must log in or register to reply here.

Similar threads

E
  • Question
Estimating Spreadsheet-Summing
Replies
1
Views
135
Peter_SSs
Peter_SSs
E
  • Solved
Summing Values
Replies
3
Views
211
LazyBug
LazyBug
B
  • Question
Matching Multiple Header Row Cell Values - Copy the data below to next available row.
Replies
1
Views
204
bobaol
B
W
  • Solved
Code for rows of cells returning reverse-order values.
Replies
5
Views
157
Worksong
W
K
  • Question
Conditional Formating - Dynamic "not between"
Replies
3
Views
254
dreid1011
dreid1011

Forum statistics

Threads
1,214,826
Messages
6,121,793
Members
449,048
Latest member
greyangel23

Share this page

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