vba help - Seperate data

[Mallesh23]

Hi Team,

Need vba help, I want to seperate my data where Cell contain "No Record"

My Dummy Data is in Column ("A:E").
Expected Output is in Column ("H:L").

Book1
	A	B	C	D	E	F	G	H	I	J	K	L
1	Invoice	Product	Amount	Product Code	Sales Man			Invoice	Product	Amount	Product Code	Sales Man
2	38692	No Record	40000		Sachin			38692	No Record	40000		Sachin
3	45262	Lux	80000	20	No Record			45262	Lux	80000	20	No Record
4	23009	Lux	80000	30	Sachin			52367	Lifebuoy	No Record	20	Dhoni
5	52367	Lifebuoy	No Record	20	Dhoni			59622	Lux	40000	No Record	Dhoni
6	53249	Lux	80000	30	Kohli			21013	Lux	80000	No Record	Kohli
7	59622	Lux	40000	No Record	Dhoni			22225	Lifebuoy	40000	30	No Record
8	21013	Lux	80000	No Record	Kohli			32752	No Record	No Record	30	Sachin
9	23701	Lux	80000	20	Dhoni			48084	No Record	80000	20	Dhoni
10	22225	Lifebuoy	40000	30	No Record			24972	Lifebuoy	No Record	20	Kohli
11	48318	Lux	40000	20	Dhoni			55267	Lux	40000	No Record	Kohli
12	32752	No Record	No Record	30	Sachin			55387	No Record	80000	20	Sachin
13	48084	No Record	80000	20	Dhoni			52272	Lifebuoy	No Record	30	Dhoni
14	35559	Lux	40000	30	Sachin			No Record	Lifebuoy	80000	30	Kohli
15	24972	Lifebuoy	No Record	20	Kohli			57887	No Record	80000	30	Kohli
16	28817	Lux	80000	30	Dhoni			47973	No Record	80000	30	Dhoni
17	21308	Lux	40000	20	Sachin			57619	Lux	40000	No Record	Dhoni
18	39018	Lifebuoy	40000	30	Kohli
19	22946	Lux	40000	20	Dhoni
20	57604	Lifebuoy	80000	30	Dhoni
21	21541	Lifebuoy	80000	30	Dhoni
22	55267	Lux	40000	No Record	Kohli
23	54834	Lifebuoy	80000	20	Sachin
24	53374	Lux	40000	30	Kohli
25	55387	No Record	80000	20	Sachin
26	43203	Lifebuoy	40000	30	Dhoni
27	59984	Lifebuoy	40000	20	Dhoni
28	52272	Lifebuoy	No Record	30	Dhoni
29	35336	Lifebuoy	40000	20	Sachin
30	No Record	Lifebuoy	80000	30	Kohli
31	51272	Lux	80000	20	Dhoni
32	57887	No Record	80000	30	Kohli
33	47973	No Record	80000	30	Dhoni
34	29859	Lifebuoy	40000	30	Kohli
35	57619	Lux	40000	No Record	Dhoni
Sheet1

Thanks
mg

 

[kevatarvind]

Hi Try Below code

Option Explicit
Sub Seprate_Data()
Dim lr As Long
Dim i As Integer
Dim rng As Range
Dim Pasterow As Integer
Pasterow = 2
lr = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lr
    Set rng = Range(Cells(i, 1), Cells(i, 5))
    If Application.WorksheetFunction.CountIf(rng, "No Record") > 0 Then
        rng.Copy Range("H" & Pasterow)
        Pasterow = Pasterow + 1
    End If
Next
Range("A1:E1").Copy Range("H1")
End Sub

 

[Fluff]

Another option

Sub Mallesh()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, cc As Long, nr As Long
   
   Ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To UBound(Ary), 1 To UBound(Ary, 2))
   
   For r = 2 To UBound(Ary)
      For c = 1 To UBound(Ary, 2)
         If Ary(r, c) = "No Record" Then
            nr = nr + 1
            For cc = 1 To UBound(Ary, 2)
               Nary(nr, cc) = Ary(r, cc)
            Next cc
            Exit For
         End If
      Next c
   Next r
   Range("H2").Resize(nr, UBound(Nary, 2)).Value = Nary
End Sub

 

[Mallesh23]

Hi kevatarvind and Fluff,

Both solution worked, Thanks for your help


Thanks
mg

 

[Fluff]

Glad we could help & thanks for the feedback.