Macro to check new lines from Masterdata and add it in another sheet based on criteria

[spvsr999]

Hi There,

This forum has been helpful to me from time to time ..!! Its helping me in learning as well as writing small automation. However, I am struck at this point in the automation I am working upon.

It would be kind of anyone who could help me with this.

Thanks a ton in advance.

Scenario:

There is data in the Master sheet and General Leder Sheet. The master sheet is linked to SAP and will be refreshed entirely (The full sheet will be deleted and refreshed data pops up) every time we run a macro.
The General ledger will have lines from the Master file with an additional column (Z) "Formula".

I want a vba code that helps me to find new lines from Master sheet and add in general ledger without disturbing the column Z

To check if the line is unique or not we will use a combination of A2,D2,F2,G2,K2,P2 respectively.

In view to hide PII, I have prepared a Demo file and updating here for reference.

Hope to receive some help soon ..!!

Master Data

Tracking Trial balance.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y
1	Account	Account Name	RC Number	RC Name	Comp Cd	PD Date	DocTyp	SAP Number	Quantities	Currency	Amount	Assignment RC	Header Text	SA Number	Doc. No.	Item Text	Personnel No	WBS Element	Reference key 3	Fiscal Year	Posting period	General Ledger Item	Document Date	Reference	General Ledger Amount
2	123456	Advance	2066	Khaan	Staff	1/7/2012	ZJ	111111	0	INR	34,789.78		Cleanup		SREEKANTH1	123456-Khaan - Staff	0			2012			1/7/2012	SREEKANTH1	34,789.78
3	123456	Advance	2066	Khaan	Staff	1/7/2012	ZJ	111111	0	INR	8,215.74		Cleanup		SREEKANTH1	123456-Khaan - Staff	0			2012			1/7/2012	SREEKANTH1	8,215.74
4	123456	Advance	3893	Patwar	Third Part	1/7/2012	ZJ	111111	0	INR	79,512.35		Cleanup		SREEKANTH1	123456-Patwar - Third Part	0			2012			1/7/2012	SREEKANTH1	79,512.35
5	123456	Advance	3893	Patwar	Third Part	1/7/2012	ZJ	111111	0	INR	19,132.76		Cleanup		SREEKANTH1	123456-Patwar - Third Part	0			2012			1/7/2012	SREEKANTH1	19,132.76
6	123456	Advance	8096	Hari	Manager	1/7/2012	ZJ	111111	0	INR	124,497.24		Cleanup		SREEKANTH1	123456-Hari - Manager	0			2012			1/7/2012	SREEKANTH1	124,497.24
7	123456	Advance	8096	Hari	Manager	1/7/2012	ZJ	111111	0	INR	54,740.41		Cleanup		SREEKANTH1	123456-Hari - Manager	0			2012			1/7/2012	SREEKANTH1	54,740.41
8	123456	Advance	8606	Gandhi	AVP	1/7/2012	ZJ	111111	0	INR	150,638.91		Cleanup		SREEKANTH1	123456-Gandhi - AVP	0			2012			1/7/2012	SREEKANTH1	150,638.91
9	123456	Advance	8606	Gandhi	AVP	1/7/2012	ZJ	111111	0	INR	55,805.47		Cleanup		SREEKANTH1	123456-Gandhi - AVP	0			2012			1/7/2012	SREEKANTH1	55,805.47
10	123456	Advance	8710	Ramcharan	Staff	1/7/2012	ZJ	111111	0	INR	120,838.14		Cleanup		SREEKANTH1	123456-Ramcharan - Staff	0			2012			1/7/2012	SREEKANTH1	120,838.14
11	123456	Advance	8710	Ramcharan	Staff	1/7/2012	ZJ	111111	0	INR	39,459.02		Cleanup		SREEKANTH1	123456-Ramcharan - Staff	0			2012			1/7/2012	SREEKANTH1	39,459.02
Master Data

General Ledger

Tracking Trial balance.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1	Account	Account Name	RC Number	RC Name	Comp Cd	PD Date	DocTyp	SAP Number	Quantities	Currency	Amount	Assignment RC	Header Text	SA Number	Doc. No.	Item Text	Personnel No	WBS Element	Reference key 3	Fiscal Year	Posting period	General Ledger Item	Document Date	Reference	General Ledger Amount	FORMULA
2	123456	Advance	2066	Khaan	Staff	1/7/2012	ZJ	111111	0	INR	34,789.78		Cleanup		SREEKANTH1	123456-Khaan - Staff	0			2012			1/7/2012	SREEKANTH1	34,789.78	xyz
3	123456	Advance	2066	Khaan	Staff	1/7/2012	ZJ	111111	0	INR	8,215.74		Cleanup		SREEKANTH1	123456-Khaan - Staff	0			2012			1/7/2012	SREEKANTH1	8,215.74	yzw
4	123456	Advance	3893	Patwar	Third Part	1/7/2012	ZJ	111111	0	INR	79,512.35		Cleanup		SREEKANTH1	123456-Patwar - Third Part	0			2012			1/7/2012	SREEKANTH1	79,512.35	abc
5	123456	Advance	3893	Patwar	Third Part	1/7/2012	ZJ	111111	0	INR	19,132.76		Cleanup		SREEKANTH1	123456-Patwar - Third Part	0			2012			1/7/2012	SREEKANTH1	19,132.76	bcd
6	123456	Advance	8096	Hari	Manager	1/7/2012	ZJ	111111	0	INR	124,497.24		Cleanup		SREEKANTH1	123456-Hari - Manager	0			2012			1/7/2012	SREEKANTH1	124,497.24	xyz
General Ledger

Thank you

 

[veyselemre]

Hi,
For the code to work, delete the spaces at the beginning of " Amount" in cell K1 in your pages.

Sub test()
    Dim adoCn As Object, rs As Object, strSQL$

    Set adoCn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("Adodb.RecordSet")

    adoCn.Provider = "Microsoft.ACE.OLEDB.12.0"
    adoCn.Properties("Data Source") = ThisWorkbook.FullName
    adoCn.Properties("Extended Properties") = "Excel 12.0; HDR=YES"
    adoCn.Open

    strSQL = "SELECT * FROM [Master Data$] AS M WHERE NOT EXISTS " & _
             "( SELECT * FROM [General Ledger$] AS G WHERE " & _
             "G.Account=M.Account  AND G.[RC Name]=M.[RC Name] AND " & _
             "G.[PD Date]=M.[PD Date] AND G.[DocTyp]=M.[DocTyp] AND " & _
             "G.[Amount]=M.[Amount] AND G.[Item Text]=M.[Item Text] ) "

    rs.Open strSQL, adoCn, 1, 1

    If rs.RecordCount > 0 Then
        Sheets("General Ledger").Range("A1").End(xlDown).Offset(1).CopyFromRecordset rs
    End If
    rs.Close
    adoCn.Close
    Set adoCn = Nothing
    Set rs = Nothing

End Sub

 

[spvsr999]

Wow .. Amazing ... You are a saver ...!!

The code is working like how I wanted .. just one small help required ..!! the code is copying the lines but not formats could you let me know where to include that as well !!!

But seriously Thank you very much @veyselemre

 

[veyselemre]

Hi,
Alternative;

Sub test()
    Dim data(), sM As Worksheet, sG As Worksheet, _
        lstRow&, i&, krt$, say&

    Set sM = Sheets("Master Data")
    Set sG = Sheets("General Ledger")

    With CreateObject("Scripting.Dictionary")
        lstRow = sG.Cells(Rows.Count, 1).End(3).Row
        data = sG.Range("A2:Y" & sG.Cells(Rows.Count, 1).End(3).Row).Value

        For i = 1 To UBound(data)
            krt = Join(Application.Index(data, i, Array(1, 4, 6, 7, 11, 16)), "|")
            .Item(krt) = i + 1
        Next i

        data = sM.Range("A2:Y" & sM.Cells(Rows.Count, 1).End(3).Row).Value
        For i = 1 To UBound(data)
            krt = Join(Application.Index(data, i, Array(1, 4, 6, 7, 11, 16)), "|")
            If Not .exists(krt) Then
                say = say + 1
                'sG.Cells(lstRow + say, 1).Resize(, 25).Value = sM.Cells(i + 1, 1).Resize(, 25).Value
                'sG.Cells(lstRow + say, 1).Resize(, 25).Value = Application.Index(data, i)
                sM.Cells(i + 1, 1).Resize(, 25).Copy sG.Cells(lstRow + say, 1) 'With format
            End If
        Next i
    End With

End Sub

 

[spvsr999]

Hi,
Alternative;

Sub test()
    Dim data(), sM As Worksheet, sG As Worksheet, _
        lstRow&, i&, krt$, say&

    Set sM = Sheets("Master Data")
    Set sG = Sheets("General Ledger")

    With CreateObject("Scripting.Dictionary")
        lstRow = sG.Cells(Rows.Count, 1).End(3).Row
        data = sG.Range("A2:Y" & sG.Cells(Rows.Count, 1).End(3).Row).Value

        For i = 1 To UBound(data)
            krt = Join(Application.Index(data, i, Array(1, 4, 6, 7, 11, 16)), "|")
            .Item(krt) = i + 1
        Next i

        data = sM.Range("A2:Y" & sM.Cells(Rows.Count, 1).End(3).Row).Value
        For i = 1 To UBound(data)
            krt = Join(Application.Index(data, i, Array(1, 4, 6, 7, 11, 16)), "|")
            If Not .exists(krt) Then
                say = say + 1
                'sG.Cells(lstRow + say, 1).Resize(, 25).Value = sM.Cells(i + 1, 1).Resize(, 25).Value
                'sG.Cells(lstRow + say, 1).Resize(, 25).Value = Application.Index(data, i)
                sM.Cells(i + 1, 1).Resize(, 25).Copy sG.Cells(lstRow + say, 1) 'With format
            End If
        Next i
    End With

End Sub

@veyselemre,

Thanks for both the solutions. I found the second one easier to tweak according to my needs.

However, in both the solutions when I try and run the macro it is taking excel into "Not responding" and is taking longer to complete the task. This may be because I will have some 2000 lines in master data.

Is there any way to fasten the process ..!!

Thanks for the help indeed

 

[veyselemre]

Hi,
try this.

Sub test()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Dim data(), sM As Worksheet, sG As Worksheet, _
        lstRow&, i&, krt$, say&, e

    Set sM = Sheets("Master Data")
    Set sG = Sheets("General Ledger")

    With CreateObject("Scripting.Dictionary")
        lstRow = sG.Cells(Rows.Count, 1).End(3).Row
        data = sG.Range("A2:Y" & sG.Cells(Rows.Count, 1).End(3).Row).Value
        
        For i = 1 To UBound(data)
            krt = ""
            For Each e In Array(1, 4, 6, 7, 11, 16)
                krt = krt & "|" & data(i, e)
            Next e
            .Item(krt) = i + 1
        Next i

        data = sM.Range("A2:Y" & sM.Cells(Rows.Count, 1).End(3).Row).Value
        
        For i = 1 To UBound(data)
            krt = ""
            For Each e In Array(1, 4, 6, 7, 11, 16)
                krt = krt & "|" & data(i, e)
            Next e

            If Not .exists(krt) Then
                say = say + 1
                sG.Cells(lstRow + say, 1).Resize(, 25).Value = sM.Cells(i + 1, 1).Resize(, 25).Value
                ' sM.Cells(i + 1, 1).Resize(, 25).Copy sG.Cells(lstRow + say, 1)    'With format
            End If
        Next i
    
    End With

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub