Need help VBA modify that find (x) number if not find 1 lower?

[motilulla]

Using Excel 2010

The following VBA first does look the number (3) in the column (I) from top to bottom then copy left side range B7:G7... And paste in to Column L below first empty cell which is working excellent.

If in the case value (3) does not find pop up massage “The criteria value 3 was not found”.

Here I need your help (step-1, I will put in the search value (3)).... if the value (3) is not found, is it possible that the VBA look for the value (2) and if the value (2) also is not found look for the value (1) finally if the value (1) is also not find then pop up massage “The criteria value 0 was 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									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	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
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
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

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 = 3                             ' <--- 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

Regards,
Moti

 

[motilulla]

Bump

 

[offthelip]

try 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 = 3                             ' <--- 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
  For critVal = 3 To 1 Step -1 
    With Application
        critRow = .IfError(.Match(critVal, critRng, 0), 0)
        If critRow > 0 Then Exit For
    End With
   Next critVal
    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]

try 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 = 3                             ' <--- 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
  For critVal = 3 To 1 Step -1
    With Application
        critRow = .IfError(.Match(critVal, critRng, 0), 0)
        If critRow > 0 Then Exit For
    End With
   Next critVal
    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

offthelip, I am happy and appreciate your help, your VBA modification is working spot-on!

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

My Best Regards,
Moti