find match values and copy

[asyamonique]

Good Day,
I have a datas on the columns ("A1:C1500)
I want to populate those values into columns (H:J)
which matching the cell ("M1") value , with column ("C") values all the way down..
Many Thanks

 

[VoG]

Try

Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Range("C" & i)
        If .Value = Range("M1").Value Then .Offset(, -2).Resize(, 3).Copy Destination:=Range("H" & Rows.Count).End(xlUp).Offset(1)
    End With
Next i
End Sub

 

[asyamonique]

Try

Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Range("C" & i)
        If .Value = Range("M1").Value Then .Offset(, -2).Resize(, 3).Copy Destination:=Range("H" & Rows.Count).End(xlUp).Offset(1)
    End With
Next i
End Sub

Thanks Vog,

 

[asyamonique]

Try

Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Range("C" & i)
        If .Value = Range("M1").Value Then .Offset(, -2).Resize(, 3).Copy Destination:=Range("H" & Rows.Count).End(xlUp).Offset(1)
    End With
Next i
End Sub

Vog,
is it possible to change to copy function like with filling or inserting coz Target Range properties changing such font size& color or table etc.....
Thanks

 

[VoG]

Try

Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Range("C" & i)
        If .Value = Range("M1").Value Then
            .Offset(, -2).Resize(, 3).Copy
            Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End If
    End With
Next i
End Sub

 

[asyamonique]

Try

Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Range("C" & i)
        If .Value = Range("M1").Value Then
            .Offset(, -2).Resize(, 3).Copy
            Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End If
    End With
Next i
End Sub

Thanks Again Vog,
If i do add more target values like M1,M2,,, together its fine by placing the codes together..
but how can i skip 1 row down after the first code run then the second can give me seperated result for to better view?

 

[VoG]

Perhaps like this

Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Range("C" & i)
        If .Value = Range("M1").Value Then
            .Offset(, -2).Resize(, 3).Copy
            Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End If
    End With
Next i
Range("H" & Rows.Count).End(xlUp).Offset(1).Value = " "
End Sub

 

[asyamonique]

Perhaps like this

Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Range("C" & i)
        If .Value = Range("M1").Value Then
            .Offset(, -2).Resize(, 3).Copy
            Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End If
    End With
Next i
Range("H" & Rows.Count).End(xlUp).Offset(1).Value = " "
End Sub

Sub Button3_Click()
Application.ScreenUpdating = False
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With Range("A" & i)
If .Value = Range("AA1").Value Then
.Offset(, 1).Resize(, 4).Copy
Range("AE" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Next i
 
Range("AE" & Rows.Count).End(xlUp).Offset(1).Value = " "
 
Dim LMR As Long, ip As Long
LMR = Range("A" & Rows.Count).End(xlUp).Row
For ip = 1 To LMR
With Range("A" & ip)
If .Value = Range("AA2").Value Then
.Offset(, 1).Resize(, 4).Copy
Range("AE" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Next ip
 
Application.ScreenUpdating = True
End Sub

Many Thanks.
Its OK now!

 

[asyamonique]

Perhaps like this

Sub test()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
    With Range("C" & i)
        If .Value = Range("M1").Value Then
            .Offset(, -2).Resize(, 3).Copy
            Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End If
    End With
Next i
Range("H" & Rows.Count).End(xlUp).Offset(1).Value = " "
End Sub

Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With Range("A" & i)
If .Value = ComboBox1.Value Then
.Offset(, 1).Resize(, 4).Copy
Range("AE" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Next i

Range("AE" & Rows.Count).End(xlUp).Offset(2).Value = " "

Dim LMR As Long, ip As Long
LMR = Range("A" & Rows.Count).End(xlUp).Row
For ip = 1 To LMR
With Range("A" & ip)
If .Value = ComboBox2.Value Then
.Offset(, 1).Resize(, 4).Copy
Range("AE" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Next ip

Vog i need ur help on my last task,
if no value in combobox2 how can i prevent that second code runing?
Thanks

 

[VoG]

Perhaps like this

Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With Range("A" & i)
If .Value = ComboBox1.Value Then
.Offset(, 1).Resize(, 4).Copy
Range("AE" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Next i

Range("AE" & Rows.Count).End(xlUp).Offset(2).Value = " "
If ComboBox2.Value = "" Then Exit Sub
Dim LMR As Long, ip As Long
LMR = Range("A" & Rows.Count).End(xlUp).Row
For ip = 1 To LMR
With Range("A" & ip)
If .Value = ComboBox2.Value Then
.Offset(, 1).Resize(, 4).Copy
Range("AE" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End If
End With
Next ip