• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Finding out new codes in a sheet those are not existing in another sheet

N

nazmul_muneer

Member
I have two sheets.

In the sheet COA the values are

----- -----------

Code Description

----- -----------

1001 AAA

1002 BBB

1003 CCC

1004 DDD

1005 EEE

1006 FFF

1007 GGG

1008 HHH

1009 III

1010 JJJ


In the sheet TB the values are (more than 50,000 rows)

----- ---------

Code Value

----- ---------

1001 100,000

1003 5,000

1004 1,000

1006 5,600

1007 8,000

1008 9,000

1009 4,000

1010 5,000

1012 8,000

1014 9,000


I want to prepare a report taking the new codes in TB sheet those are not existing in COA sheet

This report will be generated in a separate sheet
 
Hi Muneer,


Please download the below file:

http://www.2shared.com/document/V5gBMwdP/Book4.html


(Use Run button in 3rd sheet)


Thanks,

Suresh Kumar S
 
Sorry Muneer,


Please overwrite the existing code with the below code:


Sub unquiecode()

'

' unquiecode Macro

'


Worksheets("New code").Select

Columns("a:C").Select

Selection.ClearContents

Worksheets("tb").Select

Range("C2").Select

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'Code '!C[-2],1,0)"

Range("B3").Select

Selection.End(xlDown).Select

Selection.Offset(0, 1).Select

Range(Selection, Selection.End(xlUp)).Select

Selection.FillDown

Rows("1:1").Select

Selection.AutoFilter

Range("C1").Select

ActiveSheet.Range("$A$1:$C$65000").AutoFilter Field:=3, Criteria1:="#N/A"

Range("b65000").Select

Selection.End(xlUp).Select

Range(Selection, Range("a1")).Select

Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Copy

ActiveSheet.Next.Select

Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Range("A1").Select

ActiveSheet.Previous.Select

Range("A1").Select

Application.CutCopyMode = False

Selection.AutoFilter

Columns("C:C").Select

Selection.ClearContents

Range("A1").Select

ActiveSheet.Next.Select

Range("A5").Select

End Sub


Thanks,

Suresh Kumar S
 
Taking Suresh's idea a little farther and condensing the code:

[pre]
Code: 
Sub UniqueCode()
Dim LastRow As Integer

Worksheets("New code").Columns("a:C").ClearContents 'Clear old data
With Worksheets("TB")
LastRow = .Range("B3").End(xlDown).Row 'Find last row of data

'Generate helper column
.Range("C2", .Cells(LastRow, "C")).FormulaR1C1 = "=COUNTIF('COA'!C[-2],RC[-2])"

'Setup the filter
.Rows("1:1").AutoFilter
.Range("A1", .Cells(LastRow, "C")).AutoFilter Field:=3, Criteria1:="0"

'Copy the data
.Range("A3", .Cells(LastRow, "B")).SpecialCells(xlCellTypeVisible).Copy _
Worksheets("New code").Range("A1")
.Rows("1:1").AutoFilter 'Turns the autofilter off
.Range("C:C").ClearContents 'Remove helper column
End With
Worksheets("New code").Select
End Sub
[/pre]
 
Luke

I tested your code it run fine within 30000 rows in TB Sheet but when i tried 40000 rows in TB sheet it returns debug "overflow"


Provide solution plz


Muneer
 
Oops, didn't see that the spreadsheet was so big. Change the first line of code to this

Code: 
Dim LastRow As Long


Have to use something other than Integers, because Integer only works up to 32,767. My apologies.
 
Try also:

[pre]
Code: 
Option Explicit
Sub UniqueCode2()
Dim Uniq1 As Variant, Uniq2 As Variant
'Adjust Ranges to suit
Uniq1 = Application.Transpose([IF(ISNUMBER(MATCH('TB'!A2:A50000,Code!A2:A50000,0)),"~",'TB'!A2:A50000)])
Uniq2 = Application.Transpose([IF(ISNUMBER(MATCH('TB'!A2:A50000,Code!A2:A50000,0)),"~",'TB'!B2:B50000)])
Uniq1 = Filter(Uniq1, "~", False)
Uniq2 = Filter(Uniq2, "~", False)
With Sheets("New Code").Range("A2").Resize(UBound(Uniq1), 2)
.Value = Application.Transpose(Array(Uniq1, Uniq2))
.Replace 0, vbNullString, xlWhole
End With
End Sub
[/pre]
 
@Luke M

Hi!

Wrong... there are no numbers greater than 2^15-1.

Blasphemes who said that.

Regards!
 
Dear shrivallabha

Thanks for your solution


Your code runs faster. I have changed your code a little bit for finding one column and it runs fine.


Sub UniqueCode2()

Dim Uniq1 As Variant ', Uniq2 As Variant

Worksheets("New code").Columns("a:C").ClearContents 'Clear old data

'Adjust Ranges to suit

Uniq1 = Application.Transpose([IF(ISNUMBER(MATCH('TB'!A2:A50000,Code!A2:A50000,0)),~,'TB'!A2:A50000)])

'Uniq2 = Application.Transpose([IF(ISNUMBER(MATCH('TB'!A2:A50000,Code!A2:A50000,0)),~,'TB'!B2:B50000)])

Uniq1 = Filter(Uniq1, "~", False)

'Uniq2 = Filter(Uniq2, "~", False)

With Sheets("New Code").Range("A2").Resize(UBound(Uniq1), 1)

.Value = Application.Transpose(Array(Uniq1))

.Replace 0, vbNullString, xlWhole

End With

Worksheets("New code").Select

End Sub


When I changed the range A2:A75000 instead of A2:A50000 then Debug (Type mismatch)


Muneer
 
@shrivallabha


I learned something new, didn't know about the VB Filter method. Thanks for this info!
 
@Luke and shrivallabha

Would you kindly inform me how can I get result from large volume data like 75000 or above rows?

When the range is A2:A50000 it runs fine but

when the range is A2:A75000 it represent Type mismatch


Regards,

Muneer
 
Nazmul,


It is due to limitation of Array Elements. What is the size of your data?


@ Luke M,

The feeling is mutual :)


Edit: I will test the code with fake data and see if there's problem. And see if it throws any error.
 
shrivallabha,

Actually TB sheet means Trial Balance Sheet. I will keep in this sheet.....

previous year's 12 months data about 30000 rows

Current year's 12 months data (at December) 30000 rows

Current year's 12 months budget data about 20000 rows

Total 80000 rows


--Muneer
 
shrivallabha,

The sheet COA means Chart of Accounts.

In this sheet I have about 7000 rows.

Actually I want to find out which codes are new in TB sheet those are not existing in COA. For preparing Balance Sheet I have to know which codes are new in TB Sheet since I have to download Trial Balance from my Accounting software in every month.


--Muneer
 
Hi Nazmul,


Considering size of your data using Transpose Array was oversight. Test following code:

[pre]
Code: 
Option Explicit
Option Base 1
Sub UniqueCode3()
Dim objDic As Object, objUni As Object
Dim varChk As Variant, varUni As Variant
Dim i As Long

'Load Up Data into Array for processing
With Sheets("Code") 'Adjust Column Refs here!
varChk = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With

With Sheets("TB") 'Adjust Column Refs here!
varUni = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row)
End With

Set objDic = CreateObject("Scripting.Dictionary")
Set objUni = CreateObject("Scripting.Dictionary")

With objDic
.CompareMode = vbBinaryCompare

'Add all elements in Sheet Code to Dictionary
For i = 1 To UBound(varChk)
If Not .Exists(varChk(i, 1)) Then
.Add varChk(i, 1), varChk(i, 1)
End If
Next i

'Check Sheet TB now!
For i = 1 To UBound(varUni)
If Not .Exists(varUni(i, 1)) Then
If Not objUni.Exists(varUni(i, 1)) Then
objUni.Add varUni(i, 1), varUni(i, 1)
End If
End If
Next i

End With

With objUni
Sheets("New Code").Range("A1").Resize(.Count, 1).Value = Application.Transpose(.Keys)
End With

End Sub
[/pre]
 
You must log in or register to reply here.
Back
Top