VBA to copy specific cells

[topi1]

Hi, can someone please help with the macro where it copies rows (cells) B and C when the value in the corresponding rows(cells) in the column A is 1 or 2. Following is the example. Thank you.

Before VBA
1 a q
1
2 c e
2 d r
3 e t
3 f y

After VBA
a q

c e
d r

 

[Coyotex3]

Ran out of time to update my reply above to include the code tags

Sub DataSplit()
Dim i As Long
 Dim LR As Long
 
 LR = Range("A" & Rows.Count).End(xlUp).Row
 
 For i = 1 To LR
    Range("D1:D" & i).FormulaR1C1 = _
        "=IF(AND(RC[-3]<3,RC[-2]<>"""",RC[-1]<>""""),RC[-2],"""")"
    Range("E1:E" & i).FormulaR1C1 = _
        "=IF(AND(RC[-4]<3,RC[-3]<>"""",RC[-2]<>""""),RC[-2],"""")"
 Next
For i = 1 To LR
    Range("D1:E" & i).Value = Range("D1:E" & i).Value
Next
End Sub

This version eliminates the 2nd loop

Sub DataSplit()
Dim i As Long
 Dim LR As Long
 
 LR = Range("A" & Rows.Count).End(xlUp).Row
 
 For i = 1 To LR
    Range("D1:D" & i).FormulaR1C1 = _
        "=IF(AND(RC[-3]<3,RC[-2]<>"""",RC[-1]<>""""),RC[-2],"""")"
    Range("E1:E" & i).FormulaR1C1 = _
        "=IF(AND(RC[-4]<3,RC[-3]<>"""",RC[-2]<>""""),RC[-2],"""")"
 Next

    Range("D1:E" & LR).Value = Range("D1:E" & LR).Value
    
End Sub

 

[topi1]

Thanks for letting us know.


Does this one work getting what you need?
Sub DataSplit()
Dim i As Long
Dim LR As Long

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

For i = 1 To LR
Range("D1:D" & i).FormulaR1C1 = _
"=IF(AND(RC[-3]<3,RC[-2]<>"""",RC[-1]<>""""),RC[-2],"""")"
Range("E1:E" & i).FormulaR1C1 = _
"=IF(AND(RC[-4]<3,RC[-3]<>"""",RC[-2]<>""""),RC[-2],"""")"
Next
For i = 1 To LR
Range("D1:E" & i).Value = Range("D1:E" & i).Value
Next
End Sub

Thank you so much. It works as long as neither of the cells in the B and C columns from the same row is empty. Both B and C column cells have to be non-blank for it to work. Thank you so much for helping me.

RC[-3]<3 .... does this mean that the third cell to the left of the destination cell has the value that is less than 3. Trying to understand your formula. Thanks.

 

[Coyotex3]

Thank you so much. It works as long as neither of the cells in the B and C columns from the same row is empty. Both B and C column cells have to be non-blank for it to work. Thank you so much for helping me.

That is accurate. I used a formula based on the sample data you provided. Will you have data in this manner by chance:

PERSONAL.xlsm
	A	B	C
1	1	r	d
2	2		f
3	2	e
4	3	e	f
5	3	g
Sheet4

Or will it remain consistent and you only need to extract when both columns B & C have values in them?

Yes. The formula is looking 3 cells to the left for any number less than 3.

Happy to help!

 

[topi1]

That is accurate. I used a formula based on the sample data you provided. Will you have data in this manner by chance:

PERSONAL.xlsm
	A	B	C
1	1	r	d
2	2		f
3	2	e
4	3	e	f
5	3	g
Sheet4

Or will it remain consistent and you only need to extract when both columns B & C have values in them?

Yes. The formula is looking 3 cells to the left for any number less than 3.

Happy to help!

Yes. It is possible that sometime B or C may be empty. I apologize, didn't realize that it would matter when I submitted my example.

 

[Coyotex3]

Yes. It is possible that sometime B or C may be empty. I apologize, didn't realize that it would matter when I submitted my example.

Test this modification out and let me know if it works.

Sub DataSplit()
Dim i As Long
Dim LR As Long
 
 LR = Range("A" & Rows.Count).End(xlUp).Row
 
 For i = 1 To LR
    Range("D1:D" & i).FormulaR1C1 = "=IF(AND(RC[-3]<3,RC[-2]<>""""),RC[-2],"""")"
    Range("E1:E" & i).FormulaR1C1 = "=IF(AND(RC[-4]<3,RC[-2]<>""""),RC[-2],"""")"
 Next

    Range("D1:E" & LR).Value = Range("D1:E" & LR).Value
    
End Sub

 

[topi1]

Test this modification out and let me know if it works.

Sub DataSplit()
Dim i As Long
Dim LR As Long
 
 LR = Range("A" & Rows.Count).End(xlUp).Row
 
 For i = 1 To LR
    Range("D1:D" & i).FormulaR1C1 = "=IF(AND(RC[-3]<3,RC[-2]<>""""),RC[-2],"""")"
    Range("E1:E" & i).FormulaR1C1 = "=IF(AND(RC[-4]<3,RC[-2]<>""""),RC[-2],"""")"
 Next

    Range("D1:E" & LR).Value = Range("D1:E" & LR).Value
   
End Sub

Perfect. Thank you. Thank you.

 

[Alex Blakenburg]

@Coyotex3 you don't need the loop.

Sub DataSplit_mod()
    Dim i As Long
    Dim LR As Long
    
    LR = Range("A" & Rows.Count).End(xlUp).Row
    
    Range("D1:E" & LR).FormulaR1C1 = _
        "=IF(AND(RC1<3,RC[-2]<>""""),RC[-2],"""")"
    Range("D1:E" & LR).Value = Range("D1:E" & LR).Value
End Sub

 

[Coyotex3]

@Coyotex3 you don't need the loop.

Sub DataSplit_mod()
    Dim i As Long
    Dim LR As Long
   
    LR = Range("A" & Rows.Count).End(xlUp).Row
   
    Range("D1:E" & LR).FormulaR1C1 = _
        "=IF(AND(RC1<3,RC[-2]<>""""),RC[-2],"""")"
    Range("D1:E" & LR).Value = Range("D1:E" & LR).Value
End Sub

You are 100% right! This is a much better code !

Thank you for the feedback !

 

[Alex Blakenburg]

@Coyotex3, you're welcome, you were nearly there with your initial post #2

 

[topi1]

@Coyotex3, you're welcome, you were nearly there with your initial post #2

Thank you.