Excel Validation & Move

[vijaychennai]

Hello all,

Good day. I have excel in the below format.

Excel 2013/2016
	A
1	List
2	CustomerA
3	CustomerB
Sheet1

Cell Formulas
Range	Formula
A1	List
A2	CustomerA
A3	CustomerB

In Sheet 2 I have data in the below format. Need to updated the validation field.

Excel 2013/2016
	A	B	C
1	Date	Customer	Validation
2	3/28/2019	CustomerA
3	3/28/2019	CustomerB
4	3/28/2019
5	3/28/2019	Csutomer
6	3/28/2019	CsutomerC
7	3/28/2019	CustomerD
8	3/28/2019
Sheet2

Answer :

Excel 2013/2016
	A	B	C
1	Date	Customer	Validation
2	3/28/2019	CustomerA	Yes
3	3/28/2019	CustomerB	Yes
4	3/28/2019		Yes
5	3/28/2019	Csutomer	No
6	3/28/2019	CsutomerC	No
7	3/28/2019	CustomerD	No
8	3/28/2019		Yes
Sheet2

Need to move the "No" Values in to sheet 3.

Excel 2013/2016
	A	B	C
1	Date	Customer	Validation
2	3/28/2019	Csutomer	No
3	3/28/2019	CsutomerC	No
4	3/28/2019	CustomerD	No
Sheet3

Please help me to provide solution in excel VBA.

Regards,

 

[Scott T]

Try

Sub dval()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim lr1 As Long
Dim lr2 As Long
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
lr1 = ws1.Cells(Rows.Count, "A").End(xlUp).Row
lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
lr3 = ws3.Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To lr2
    If ws2.Cells(x, "B") = "" Or IsNumeric(Application.Match(ws2.Cells(x, "B"), ws1.Range("A2:A" & lr1), 0)) Then
        ws2.Cells(x, "C") = "Yes"
    Else
        ws2.Cells(x, "C") = "No"
    End If
Next x
For y = 2 To lr2
    If ws2.Cells(y, "C") = "No" Then
        ws2.Range("A" & y & ":C" & y).Cut Destination:=ws3.Range("A" & lr3 + 1)
        lr3 = ws3.Cells(Rows.Count, "A").End(xlUp).Row
    End If
Next y
ws2.Range("A2:C" & lr2).SpecialCells(xlBlanks).Delete xlUp
End Sub

 

[vijaychennai]

Hello Frnd,

it's working fine... but i have 1 lakh data it's getting delay to update.

Regards,