Find (x) number copy some left cell and paste into another location

[motilulla]

Using Excel 2010
Hello,

I want a VBA which can look first (x) number from top to bottom in the column (I) in this example look for number (2) which is finding in cell (I20) copy left side range B20:G20... And paste in to Column L below the first empty cell

Note: if search number is not found exit sub

S.N	n1	n2	n3	n4	n5	n6		Find X Num			n1	n2	n3	n4	n5	n6
1	1	2	4	6	12	15		5			1	2	4	6	12	15
2	1	2	4	6	12	16		4			1	2	4	16	26	28	Step 2 <---After Finding 2 Copy Range B20:G20 And Paste into Column L below the first empty cell
3	1	2	4	6	12	26		4
4	1	2	4	6	15	41		4
5	1	2	4	6	15	43		4
6	1	2	4	6	16	26		3
7	1	2	4	6	28	43		3
8	1	2	4	6	37	43		3
9	1	2	4	6	41	43		3
10	1	2	4	12	15	16		4
11	1	2	4	12	15	26		4
12	1	2	4	12	15	28		4
13	1	2	4	12	15	31		4
14	1	2	4	15	16	26		3
15	1	2	4	15	16	28		3
16	1	2	4	15	16	37		3
17	1	2	4	15	16	41		3
18	1	2	4	15	16	43		3
19	1	2	4	16	26	28		2	Step 1 <-----Find 1st 2 in column I and copy left 6 numbers from range B:G....Paste in to Column L below the first empty cell
20	1	2	4	16	26	31		2
21	1	2	4	16	26	37		2
22	1	2	4	16	26	41		2
23	1	2	4	16	26	43		2
24	1	2	4	16	28	31		2
25	1	2	4	16	28	37		2
26	16	26	28	31	41	43		0
27	16	26	28	37	41	43		0
28	16	26	31	37	41	43		0

Regards,
Moti

 

[Alex Blakenburg]

Do you only want the first occurence of "2" copied ?
Do you want the copied data removed from the left side ?

 

[Alex Blakenburg]

Let's start with this:

Sub CopyRow()

    Dim ws As Worksheet
    Dim srcRng As Range, critRng As Range
    Dim srcRowLast As Long, destRowLast As Long, critRow As Long
    Dim srcCols As Long
    Dim critVal As Long                     ' <--- Change to string or double if text or decimal
    
    critVal = 2                             ' <--- Change to value to find or use input box or input cell
    Set ws = Worksheets("Data")             ' <--- Change to your worksheet name
    With ws
        srcRowLast = .Range("I" & Rows.Count).End(xlUp).Row
        Set srcRng = .Range("B1:G" & srcRowLast)
        srcCols = srcRng.Columns.Count
        Set critRng = .Range("I1:I" & srcRowLast)
        destRowLast = .Range("L" & Rows.Count).End(xlUp).Row
    End With
    
    With Application
        critRow = .IfError(.Match(critVal, critRng, 0), 0)
    End With
    
    If critRow = 0 Then
        MsgBox "The criteria value " & critVal & " was not found"
        Exit Sub
    End If
    destRowLast = destRowLast + 1
    ws.Range("L" & destRowLast).Resize(, srcCols).Value = srcRng.Rows(critRow).Value

End Sub

 

[motilulla]

Do you only want the first occurence of "2" copied ?
Do you want the copied data removed from the left side ?

Let's start with this:

Sub CopyRow()

    Dim ws As Worksheet
    Dim srcRng As Range, critRng As Range
    Dim srcRowLast As Long, destRowLast As Long, critRow As Long
    Dim srcCols As Long
    Dim critVal As Long                     ' <--- Change to string or double if text or decimal
  
    critVal = 2                             ' <--- Change to value to find or use input box or input cell
    Set ws = Worksheets("Data")             ' <--- Change to your worksheet name
    With ws
        srcRowLast = .Range("I" & Rows.Count).End(xlUp).Row
        Set srcRng = .Range("B1:G" & srcRowLast)
        srcCols = srcRng.Columns.Count
        Set critRng = .Range("I1:I" & srcRowLast)
        destRowLast = .Range("L" & Rows.Count).End(xlUp).Row
    End With
  
    With Application
        critRow = .IfError(.Match(critVal, critRng, 0), 0)
    End With
  
    If critRow = 0 Then
        MsgBox "The criteria value " & critVal & " was not found"
        Exit Sub
    End If
    destRowLast = destRowLast + 1
    ws.Range("L" & destRowLast).Resize(, srcCols).Value = srcRng.Rows(critRow).Value

End Sub

Alex Blakenburg, yes I wanted the first occurrence of "2" should only be copied, and that is exactly your VBA is working spot on it.

I am happy and appreciate your kind help very much.

I wish you a healthy and happy new year 2024. Good Luck!

My Best Regards,
Moti

I did not even thought about 2nd options you gave me. That the copied data can be removed from the left side? I am thinking now it would be good idea please if it is not much trouble for you can you make it possible. Thank you

 

[Alex Blakenburg]

Thanks for letting me know.
To delete from A:I in the selected row replace:

   ws.Range("L" & destRowLast).Resize(, srcCols).Value = srcRng.Rows(critRow).Value

With this:

    With srcRng.Rows(critRow)
        ws.Range("L" & destRowLast).Resize(, srcCols).Value = .Value
        .Offset(, -1).Resize(, .Columns.Count + 3).Delete Shift:=xlUp        ' Expand range to A:I and delete
    End With

 

[motilulla]

Thanks for letting me know.
To delete from A:I in the selected row replace:

   ws.Range("L" & destRowLast).Resize(, srcCols).Value = srcRng.Rows(critRow).Value

With this:

    With srcRng.Rows(critRow)
        ws.Range("L" & destRowLast).Resize(, srcCols).Value = .Value
        .Offset(, -1).Resize(, .Columns.Count + 3).Delete Shift:=xlUp        ' Expand range to A:I and delete
    End With

Alex Blakenburg, I am grateful to you for this modification. It is really yours amazing thought to remove copied data from the left side. It has been really useful.

I am so happy. Good Luck! Happy Year 2024! Stay Blessed.

My Best Regards,
Moti

 

[Alex Blakenburg]

Thank you & Happy New Year to you too.