PDA

View Full Version : [SOLVED] Same condition, multiple columns check, then copy rows



katy.brooke
07-05-2017, 06:25 AM
Hi all.
Really exceptionally new to VBA - think about 2 hours, so this is definitely above my skill level but you guys seem amazing, I have already used one of the macros found in another post to do something, so thanks for that. This one is a little more complicated.

I am trying to create a Macro that searches multiple columns of names from a different sheet to find a name that is in a specific cell, and if the name is found in any of those rows, to copy the rows across to the first sheet. So far I managed to check the first column of names, but the only way I've managed to do it is by copying everything across then deleting the ones that I don't need (See Macro below) which I got from a co-worker, but I need to check 8 rows, and that is just not going to work with the code that I already have. Although, if you see the what the code does, it might make more sense as to what I am trying to do. My current macro is:


Sub DeleteRows() 'could be useful to use a do while for deleting rows

Dim i As Integer
i = 5 'starting row
j = 3
Range("Data").Copy 'Copies data"
Sheet4.Cells(i, 1).PasteSpecial Paste:=xlPasteValues 'Pastes data values (may need to paste formatting)

Do While Not IsEmpty(Sheet4.Cells(i, 1).Value) '1 is the column value (change as needed)

If Sheet4.Cells(i, 3).Value <> Range("A1") Then
Sheet4.Rows(i).Delete
Else
i = i + 1
End If
Loop

Sheet4.Cells(i, 1).Select 'return cursor to original position


End Sub
But this clearly won't work!

I have added an excel spreadsheet with some sample data(names obviously changed) in the structure I am looking for. If anything is unclear please let me know!

Summary: I want to be able to type different names in cell B5 in Sheet2 (Personal) and have the button run through columns D-K in Sheet1 (All) to find if that name appears, and if it does, copy the row across to Sheet2 (Personal) starting in row 8.

(I will then be using this data to create a Gantt chart for each individual if you were curious as to what was going on).

Any help is super appreciated! Thanks!

mdmackillop
07-05-2017, 07:09 AM
Sub Test()
Dim r As Range, tgt As Range, Rw As Range
Dim Data As String
Dim LR As Long


Data = Sheets("Personal").Cells(5, 2)
With Sheets("All")
LR = .Cells(Rows.Count, 1).End(xlUp).Row
Set r = Range(.Cells(5, 4), .Cells(LR, 11))
For Each Rw In r.Rows
If Not IsError(Application.Match(Data, Rw, 0)) Then
Rw.EntireRow.Copy Sheets("Personal").Cells(Rows.Count, 1).End(xlUp)(2)
End If
Next Rw
End With
End Sub

katy.brooke
07-05-2017, 08:27 AM
Sub Test()
Dim r As Range, tgt As Range, Rw As Range
Dim Data As String
Dim LR As Long


Data = Sheets("Personal").Cells(5, 2)
With Sheets("All")
LR = .Cells(Rows.Count, 1).End(xlUp).Row
Set r = Range(.Cells(5, 4), .Cells(LR, 11))
For Each Rw In r.Rows
If Not IsError(Application.Match(Data, Rw, 0)) Then
Rw.EntireRow.Copy Sheets("Personal").Cells(Rows.Count, 1).End(xlUp)(2)
End If
Next Rw
End With
End Sub


Thankyouthankyouthankyou!That works great! P.S. Great profile pic, I have a Ridgeback as well. :-)