Creating a new rows from information from one row

[Sdwd76]

I have a rows - Lets say each row has a common field in Col A which is always a unique reference number.

Each reference number will have attributes such as colour, sex, age and chipped. (There are about 25 of these)

Every week we get information sent from various staff on site about each reference number

After comparing the info with a master table. The outcome is generated and matched with what's on the master. Any attribute changes is compared and flagged up via an =EXACT between weekly data and the master.

So we will have a massive list of FALSE where the two do not align.

Question is this.

if reference 11111 shows up having FALSE in sex and age then i want it to copy various cells to another sheet.

So the other sheet looks like (showing what needs to be changed and to what) The information from sites is what we go on.

REF CHANGE SEX AGE
111111 SEX F
111111 AGE 9

I would love this to be done via a button. Any help to generate code i would be grateful. Thanks

 

[Sdwd76]

so something like this? Data and what the output needs to look like?

 

[Sdwd76]

Hi all this moves the whole row but i only want certain column data copying and not actually removing?

please could someone help with the correct syntax to copy just col c and E if the condition in O is met?

thanks in advancd




Sub MOVETEST()
Application.ScreenUpdating = False

Dim rs1 As Worksheet, rs2 As Worksheet
Set rs1 = Sheets("Sheet1")
Set rs2 = Sheets("Sheet2")

Lr = rs1.Range("A" & Rows.Count).End(xlUp).Row

For r = 1 To Lr

If rs1.Cells(r, "O") = "FALSE" Then
rs1.Cells(r, "A").EntireRow.Copy Destination:=rs2.Range("A" & Rows.Count).End(xlUp).Offset(1)
rs1.Cells(r, "A") = True

End If

Next r

On Error Resume Next
rs1.Range("A1:A" & Lr).SpecialCells(xlCellTypeConstants, 4).EntireRow.Delete
On Error GoTo 0

Application.ScreenUpdating = True

End Sub

 

[Sdwd76]

Had another play and some progress so i can now copy columns based on O being FALSE
however this does not continue down?



Sub MOVETEST()

Dim sourceWorksheet As Worksheet
Dim targetWorksheet As Worksheet

Dim searchString As String
Dim lastSourceRow As Long
Dim startSourceRow As Long
Dim lastTargetRow As Long
Dim sourceRowCounter As Long
Dim columnToEval As Long
Dim columnCounter As Long

Dim columnsToCopy As Variant


Set sourceWorksheet = ThisWorkbook.Worksheets("Sheet1")
Set targetWorksheet = ThisWorkbook.Worksheets("Sheet2")

columnsToCopy = Array(3, 2, 4, 5)

searchString = "FALSE"

startSourceRow = 1

columnToEval = 15

lastSourceRow = sourceWorksheet.Cells(sourceWorksheet.Rows.Count, 1).End(xlUp).Row

For sourceRowCounter = startSourceRow To lastSourceRow
If sourceWorksheet.Cells(sourceRowCounter, columnToEval).Value = searchString Then

lastTargetRow = targetWorksheet.Cells(targetWorksheet.Rows.Count, 1).End(xlUp).Row

For columnCounter = 0 To UBound(columnsToCopy)

targetWorksheet.Cells(lastTargetRow, columnsToCopy(columnCounter)).Offset(1, 0).Value = sourceWorksheet.Cells(sourceRowCounter, columnsToCopy(columnCounter)).Value

Next columnCounter

End If

Next sourceRowCounter

sourceWorksheet.Activate

End Sub