EMBED VLOOKUP AND SIMPLE IF FORMULA IN A WORKBOOK

[Angela]

Hello friends,

I have a set of work sheets in a workbook.

sheet1 name is (DATA)
sheet2 name is (SALE)

In sheet SALE, cell B2 value is either blank or "Found" using formula
=IF(A2<>"","FOUND","") and it continues for each value of found in
corresponding columnA.

In sheet DATA, cell I2, value is either "Check" or "Found" using =IF(IF
(E2<>"",ISNA(VLOOKUP(E2,SALE!$A$2:$B$65535,2,FALSE)),"")
<>FALSE,"Check","Found") and it continues for each value found in
corresponding columnE that matches with columnA value of sheet (SALE).

Now problem is that it takes too much time to calculate formulas in
both sheets since data is extended to 30000+ lines.

I would also like to generate a new worksheet with name "CHECK" which
should contain only check data from sheet(DATA). I can do this with
pivot table but I would like to get this using VB.

Hope I have explained things clearly here.

Would appreciate if someone can code all the formulas to reduce
calculation time of workbook.

Thx.

 

[joel]

the code assume there is a sheet caleed Check

Sub GetcheckData()

Set Salesht = Sheets("Sale")
Set DataSht = Sheets("Data")
Set CheckSht = Sheets("Check")
CheckSht.ClearContents

CheckRow = 2

With DataSht
'copy head row
.Rows(1).Copy Destination:=CheckSht.Rows(1)
LastRow = .Range("E" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
If .Range("E" & RowCount) <> "" Then
Data = .Range("E" & RowCount)
Set c = Salesht.Columns("A").Find(what:=Data, _
LookIn:=xlValues, lookat:=xlWhole)
'if data is not found in sheet Sales
If Not c Is Nothing Then
.Rows(RowCount).Copy _
Destination:=CheckSht.Rows(RowCount)
RowCount = RowCount + 1
End If
End If
Next RowCount
End With
End Sub

 

[Angela]

the code assume there is a sheet caleed Check

Sub GetcheckData()

Set Salesht = Sheets("Sale")
Set DataSht = Sheets("Data")
Set CheckSht = Sheets("Check")
CheckSht.ClearContents

CheckRow = 2

With DataSht
   'copy head row
   .Rows(1).Copy Destination:=CheckSht.Rows(1)
   LastRow = .Range("E" & Rows.Count).End(xlUp).Row
   For RowCount = 2 To LastRow
      If .Range("E" & RowCount) <> "" Then
         Data = .Range("E" & RowCount)
         Set c = Salesht.Columns("A").Find(what:=Data, _
            LookIn:=xlValues, lookat:=xlWhole)
         'if data is not found in sheet Sales
         If Not c Is Nothing Then
            .Rows(RowCount).Copy _
               Destination:=CheckSht.Rows(RowCount)
            RowCount = RowCount + 1
         End If
      End If
   Next RowCount
End With
End Sub














- Show quoted text -

Hi Joel,

Thanks for the reply.
On line "CheckSht.ClearContents" it is giving an error "Object doesn't
support this property or method".

In check sheet, the result is like one line skip and another.
Example if in sale sheet I have

1745
1746
1747
1748
1749

Then result I get in check sheet is
1745

1747

1748

Why is that so?
Would appreciate if you can check it pls.

Thx.

 

[joel]

You didn't tell me which line gave the error but I believe this line need to
be changed

from
CheckSht.ClearContents
to
CheckSht.Cells.ClearContents

 

[Angela]

You didn't tell me which line gave the error  but I believe this line need to
be changed

from
CheckSht.ClearContents
to
CheckSht.Cells.ClearContents









- Show quoted text -

Hi Joel,

I did mention in my post the error line.
On line "CheckSht.ClearContents" it is giving an error "Object
doesn't
support this property or method".

Also pls check why it is skipping one line after another in the check
sheet.


Thx for your help.
Waiting for reply

 

[joel]

Remove this line. It is not needed. It explains why the code is skipping a
line

RowCount = RowCount + 1

 

[joel]

Ignore my last masseage. Try this new code

Sub GetcheckData()

Set Salesht = Sheets("Sale")
Set DataSht = Sheets("Data")
Set CheckSht = Sheets("Check")
CheckSht..cells.ClearContents

CheckRow = 2

With DataSht
'copy head row
.Rows(1).Copy Destination:=CheckSht.Rows(1)
LastRow = .Range("E" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
If .Range("E" & RowCount) <> "" Then
Data = .Range("E" & RowCount)
Set c = Salesht.Columns("A").Find(what:=Data, _
LookIn:=xlValues, lookat:=xlWhole)
'if data is not found in sheet Sales
If Not c Is Nothing Then
.Rows(RowCount).Copy _
Destination:=CheckSht.Rows(CheckRow)
CheckRow = CheckRow + 1
End If
End If
Next RowCount
End With
End Sub

 

[Angela]

Remove this line.  It is not needed.  It explains why the code is skipping a
line

RowCount = RowCount + 1









- Show quoted text -

Hi Joel,

The code is working but there is some confusion.
It is getting information corresponding to values in sheet Sale.
I want to eliminate and get those values which are aprat from sale
data.

Like if I have 1746 in sale sheet and 1476, 1477, 1478 in data sheet,
then I want to get 1477, 1478 in check sheet.
HTC.

Thx.

 

[joel]

from
If Not c Is Nothing Then

to
If c Is Nothing Then

 

[Angela]

from
If Not c Is Nothing Then

to
If c Is Nothing Then









- Show quoted text -

Hi Joel,

Thank you for your patience.
Well can we speed up the process? Takes some time for only 8000 lines.

Thx any way.

Angela

 

[joel]

Copying one row of data at a time between worksheets can be slow. when time
is important I can make the code more complicated, but it will run quicker.
Instead of copying one row at a time the code below puts an "X" in column IV
marking the rows to copy. Then the code uses autofilter to to filter the
rows with the X. Next the code uses SpecialCells method to copy the
filtered rows. Finally the code deletes the column with the X and removes
the autofilter.

Sub GetcheckData()

Set Salesht = Sheets("Sale")
Set DataSht = Sheets("Data")
Set CheckSht = Sheets("Check")
CheckSht.Cells.ClearContents

CheckRow = 2

With DataSht
'put x in column IV to indicate copy
.Range("IV1") = "X"
LastRow = .Range("E" & Rows.Count).End(xlUp).Row
For RowCount = 2 To LastRow
If .Range("E" & RowCount) <> "" Then
Data = .Range("E" & RowCount)
Set c = Salesht.Columns("A").Find(what:=Data, _
LookIn:=xlValues, lookat:=xlWhole)
'if data is not found in sheet Sales
If c Is Nothing Then
.Range("IV" & RowCount) = "X"
End If
End If
Next RowCount
'filter Results
.Columns("IV:IV").AutoFilter
.Columns("IV:IV").AutoFilter Field:=1, Criteria1:="X"
.Cells.SpecialCells(Type:=xlCellTypeVisible).Copy _
Destination:=CheckSht.Cells
.ShowAllData
'delete columns witht "X"
.Columns("IV").Delete
CheckSht.Columns("IV").Delete
End With

End Sub