Transferring selected cells to a new sheet

[Needlotshelp]

Hi,

I have attached a Excel workbook and I need help!

in first tab 'Primary Data' last column is 'Vulnerabilities Found' where some of the rows show 'Yes'. What I need is to move corresponding values from 'Test Area' and 'CO Number' to move to the next sheet which is 'Vulnerabilities', not the whole row but just these two fields. Rest of the fields will be filled out manually based on a different report.

Similarly, from Vulnerabilities Column O is 'Status' which displays 'In remediation' and 'Exception requested'. From this columns 'Exception requested' goes to sheet 'Exception' and 'In remediation' goes to sheet 'Remidiation'. Again just the two fields 'Test Area' and 'CO Number'. Rest of the fields are filled manually.

I tried using formulas but it is copying over a whole lot than what is needed, can VBA do this?

How do I do that? I appreciate any help!

Thank you.

[Needlotshelp]

anyone! Please i need help. I think code will be similar for all three sheets since it is the same thing that is requiired.

[大灰狼1976]

Hi!
Because you have a lot of manual content, so I think you do it in several steps, I wrote the operation of each step as a separate macro. Something like below.



Sub Pri2Vul()
Dim arrOri, i&, r&, arrRst(1 To 1000, 1 To 2)
arrOri = Sheets("Primary Data").[a1].CurrentRegion
For i = 2 To UBound(arrOri)
If arrOri(i, 18) = "Yes" Then
r = r + 1
arrRst(r, 1) = arrOri(i, 2)
arrRst(r, 2) = arrOri(i, 3)
End If
Next i
Sheets("Vulnerabilities").[b2].Resize(1000, 2) = arrRst
End Sub



Sub Vul2RemOrExc()
Dim arrOri, i&, r1&, r2&, arrRem(1 To 1000, 1 To 2), arrExc(1 To 1000, 1 To 2)
arrOri = Sheets("Vulnerabilities").[a1].CurrentRegion
For i = 2 To UBound(arrOri)
If arrOri(i, 15) = "Exception requested" Then
r1 = r1 + 1
arrExc(r1, 1) = arrOri(i, 2)
arrExc(r1, 2) = arrOri(i, 3)
ElseIf arrOri(i, 15) = "In remediation" Then
r2 = r2 + 1
arrRem(r2, 1) = arrOri(i, 2)
arrRem(r2, 2) = arrOri(i, 3)
End If
Next i
Sheets("Remidiation").[b2].Resize(1000, 2) = arrRem
Sheets("Exception").[b2].Resize(1000, 2) = arrExc
End Sub

[Needlotshelp]

This is beautiful! cant thank you enough! i think i will create buttons that will make it a whole lot easier.

[Needlotshelp]

Thanks for all the help! I added the buttons and it worked fine but I came across an issue. Both these macros update existing data what if i only wanted to move new data? so for example I added new data on first sheet and want only that data copied over to next sheet. I actually like both ideas that I can only add new data and at time when necessary update all date. how can that be accomplished?

[大灰狼1976]

Hi!
Something like below. Can keep the original data.


Sub Pri2Vul()
Dim arrOri, i&, r&, arrRst(1 To 1000, 1 To 2)
arrOri = Sheets("Primary Data").[a1].CurrentRegion
For i = 2 To UBound(arrOri)
If arrOri(i, 18) = "Yes" Then
r = r + 1
arrRst(r, 1) = arrOri(i, 2)
arrRst(r, 2) = arrOri(i, 3)
End If
Next i
Sheets("Vulnerabilities").Cells(Rows.Count, "b").End(3).Offset(1).Resize(r, 2) = arrRst
End Sub



Sub Vul2RemOrExc()
Dim arrOri, i&, r1&, r2&, arrRem(1 To 1000, 1 To 2), arrExc(1 To 1000, 1 To 2)
arrOri = Sheets("Vulnerabilities").[a1].CurrentRegion
For i = 2 To UBound(arrOri)
If arrOri(i, 15) = "Exception requested" Then
r1 = r1 + 1
arrExc(r1, 1) = arrOri(i, 2)
arrExc(r1, 2) = arrOri(i, 3)
ElseIf arrOri(i, 15) = "In remediation" Then
r2 = r2 + 1
arrRem(r2, 1) = arrOri(i, 2)
arrRem(r2, 2) = arrOri(i, 3)
End If
Next i
Sheets("Remidiation").Cells(Rows.Count, "b").End(3).Offset(1).Resize(r2, 2) = arrRem
Sheets("Exception").Cells(Rows.Count, "b").End(3).Offset(1).Resize(r1, 2) = arrExc
End Sub

[Needlotshelp]

Thanks for all the time! It works however for both updated macros, they keep original data abd are copying all data from previous sheets so now there is duplication.

[Needlotshelp]

I am using the original macros that you had sent and they are working just great! However I came accross an issue...for example in 'Primary Data' sheet if i am adding data and first three have no Vulnerabilities and next three do. I move data to 'Vulnerabilities' sheet using the macro which it does. Now if I make changes to 'Vulnerabilities' column on first sheet like flip a No to Yes it it just replacing existing data. It should add a row or add the newly flipped row at the bottom.
This is because if it does not do that data in columns D to O will be incorrect. Please help me with this.

[大灰狼1976]

Hi!
Then I have another question:
How to deal with the original "Yes" row in the "Primary Data" worksheet when it becomes "No".

[Needlotshelp]

Thanks for replying. If a No is updated to Yes...a new row should be added so it does not disturb existing data. and if a Yes is updated to No it should remove entire row. I hope i am making sense.

[大灰狼1976]

Sorry, i am busy these days.
First one:

Sub Pri2Vul()
Dim arrOri, i&, j&, rngDel As Range, r&
arrOri = Sheets("Primary Data").[a1].CurrentRegion
With Sheets("Vulnerabilities")
For i = 2 To UBound(arrOri)
r = .Cells(1, 2).End(4).Row
For j = 2 To r
If arrOri(i, 2) = .Cells(j, 2) And arrOri(i, 3) = .Cells(j, 3) Then Exit For
Next j
If j > r Then
If arrOri(i, 18) = "Yes" Then .Cells(r + 1, 2).Resize(, 2) = Array(arrOri(i, 2), arrOri(i, 3))
Else
If arrOri(i, 18) = "No" Then
If rngDel Is Nothing Then Set rngDel = .Rows(j) Else Set rngDel = Union(rngDel, .Rows(j))
End If
End If
Next i
End With
If Not rngDel Is Nothing Then rngDel.Delete
End Sub

[大灰狼1976]

Last one:

Sub Vul2RemOrExc()
Dim arrOri, i&, j&, r&, rngDelEx As Range, rngDelIn As Range
arrOri = Sheets("Vulnerabilities").[a1].CurrentRegion
For i = 2 To UBound(arrOri)
With Sheets("Exception")
r = .Cells(1, 2).End(4).Row
For j = 2 To r
If arrOri(i, 2) = .Cells(j, 2) And arrOri(i, 3) = .Cells(j, 3) Then Exit For
Next j
If j > r Then
If arrOri(i, 15) = "Exception requested" Then .Cells(r + 1, 2).Resize(, 2) = Array(arrOri(i, 2), arrOri(i, 3))
Else
If arrOri(i, 15) = "In remediation" Then
If rngDelEx Is Nothing Then Set rngDelEx = .Rows(j) Else Set rngDelEx = Union(rngDelEx, .Rows(j))
End If
End If
End With
With Sheets("Remidiation")
r = .Cells(1, 2).End(4).Row
For j = 2 To r
If arrOri(i, 2) = .Cells(j, 2) And arrOri(i, 3) = .Cells(j, 3) Then Exit For
Next j
If j > r Then
If arrOri(i, 15) = "In remediation" Then .Cells(r + 1, 2).Resize(, 2) = Array(arrOri(i, 2), arrOri(i, 3))
Else
If arrOri(i, 15) = "Exception requested" Then
If rngDelIn Is Nothing Then Set rngDelIn = .Rows(j) Else Set rngDelIn = Union(rngDelIn, .Rows(j))
End If
End If
End With
Next i
If Not rngDelEx Is Nothing Then rngDelEx.Delete
If Not rngDelIn Is Nothing Then rngDelIn.Delete
End Sub

[Needlotshelp]

thanks for all the effort, i was out sick. will check this tomorrow and will let you know how it went. thanks again!

[Needlotshelp]

Was fianlly able to get to this, thanks for all the help!!