Match three columns together across sheet to subtraction based invoice number

abdo meghari · Sep 22, 2024

Hello
I have theses data for four sheets

DECREASE.xlsm

A

B

C

D

E

F

G

H

I

1

ITEM

DATE

INV.NO

BRAND

TYPE

ORIGIN

QTY

PRICE

TOTAL

2

1

15/06/2023

BSTR_23448

BS 750R16

R230

JAP

4.00

500.00

2,000.00

3

2

15/06/2023

BSTR_23448

BS 700R16

R230

JAP

2.00

400.00

800.00

4

SUM

2,800.00

5

1

15/09/2023

BSTR_23449

GO 1200R20

AZ0026

CHI

1.00

920.00

6

2

15/09/2023

BSTR_23449

GO 1200R20

AZ0083

CHI

2.00

1,000.00

2,000.00

7

SUM

2,920.00

8

1

15/09/2023

BSTR_23450

BS 1200R20

G580

JAP

10.00

1,800.00

18,000.00

9

2

15/09/2023

BSTR_23450

BS 1200R20

G580

THI

10.00

1,800.00

18,000.00

10

3

15/09/2023

BSTR_23450

BS 1200R20

R187

THI

10.00

1,800.00

18,000.00

11

SUM

54,000.00

12

1

16/09/2023

BSTR_23451

BS 215/60R16

ER30

JAP

4.00

400.00

1,600.00

13

SUM

1,600.00

14

1

16/09/2023

BSTR_23452

BS 1200R20

G580

JAP

5.00

1,800.00

9,000.00

15

SUM

9,000.00

16

1

16/09/2023

BSTR_23453

BS 1200R20

G580

JAP

5.00

1,880.00

9,400.00

17

SUM

9,400.00

SV

DECREASE.xlsm

A

B

C

D

E

F

G

H

I

1

ITEM

DATE

INV.NO

BRAND

TYPE

ORIGIN

QTY

PRICE

TOTAL

2

1

10/06/2023

BSJ_23444

BS 215/60R16

ER30

JAP

4.00

430.00

1,720.00

3

SUM

1,720.00

4

1

10/06/2023

BSJ_23445

GO 1200R20

AZ0026

CHI

2.00

955.00

1,910.00

5

SUM

1,910.00

6

1

15/09/2023

BSJ_23446

GO 1200R20

AZ0026

CHI

2.00

950.00

1,900.00

7

2

15/09/2023

BSJ_23446

GO 1200R21

AZ0027

CHI

3.00

1,000.00

3,000.00

8

SUM

4,900.00

9

1

15/09/2023

BSJ_23447

BS 1200R20

G580

JAP

1.00

2,000.00

10

2

15/09/2023

BSJ_23447

BS 1200R20

G580

THI

1.00

2,000.00

11

3

15/09/2023

BSJ_23447

BS 1200R20

R187

THI

1.00

2,000.00

12

SUM

6,000.00

SR

DECREASE.xlsm

A

B

C

D

E

F

G

H

I

J

1

ITEM

DATE

INV.NO

BRAND

TYPE

ORIGIN

QTY

PRICE

TOTAL

NOTICE

2

1

15/06/2023

VSTR_23444

BS 750R16

R230

JAP

1.00

500.00

INV.NO BSTR_23448

3

SUM

500.00

4

1

15/09/2023

VSTR_23445

GO 1200R20

AZ0083

CHI

1.00

1,000.00

INV.NO BSTR_23449

5

SUM

1,000.00

6

1

15/09/2023

VSTR_23446

BS 1200R20

G580

JAP

1.00

1,800.00

INV NO BSTR_23450

7

2

15/09/2023

VSTR_23446

BS 1200R20

G580

THI

1.00

1,800.00

INV NO BSTR_23450

8

SUM

3,600.00

9

1

16/09/2023

VSTR_23447

BS 215/60R16

ER30

JAP

4.00

400.00

1,600.00

INV NO BSTR_23451

10

SUM

1,600.00

11

1

16/09/2023

VSTR_23448

BS 1200R20

G580

JAP

1.00

1,800.00

INV NO BSTR_23452

12

SUM

1,800.00

13

1

16/09/2023

VSTR_23449

BS 1200R20

G580

JAP

2.00

1,880.00

3,760.00

INV NO BSTR_23453

14

SUM

3,760.00

VS

DECREASE.xlsm

A

B

C

D

E

F

G

H

I

J

2

1

10/06/2023

RSS_23222

BS 215/60R16

ER30

JAP

2.00

430.00

860.00

INV.NO BSJ_23444

3

SUM

860.00

4

1

10/06/2023

BSJ_23445

GO 1200R20

AZ0026

CHI

1.00

955.00

INV.NO BSJ_23445

5

SUM

955.00

6

1

15/09/2023

BSJ_23446

GO 1200R20

AZ0026

CHI

1.00

950.00

INV.NO BSJ_23446

7

2

15/09/2023

BSJ_23446

GO 1200R21

AZ0027

CHI

2.00

1,000.00

2,000.00

INV.NO BSJ_23446

8

SUM

2,950.00

RS

what I want matching columns D:F in SV sheet with columns D:F in VS sheet based on invoice number is in column(J)
if the invoice number in column J in s VS sheet is the same invoice number in column(C) in SV sheet then should subtract QTY for ID in columns D:F in SV sheet from VS sheet and change calculation for TOTAL column for each ID and SUM row for whole invoice number and should put word DONE in column J for adjacant ID cells to avoid subtraction every time repeatedly(meaning when there is DONE word shouldn't do any thing). and if there is the same ID for the same QTY then should delete the whole row for ID like 215/60R16 ER30 and whole row for SUM row if there is no another ID for the same invoice number .as to PRICE column will not change because will be the same

so in result in SV sheet should be as highlighted cells

DECREASE.xlsm

A

B

C

D

E

F

G

H

I

J

1

ITEM

DATE

INV.NO

BRAND

TYPE

ORIGIN

QTY

PRICE

TOTAL

2

1

15/06/2023

BSTR_23448

BS 750R16

R230

JAP

3.00

500.00

1,500.00

DONE

3

2

15/06/2023

BSTR_23448

BS 700R16

R230

JAP

2.00

400.00

800.00

DONE

4

SUM

2,300.00

5

1

15/09/2023

BSTR_23449

GO 1200R20

AZ0026

CHI

1.00

920.00

6

2

15/09/2023

BSTR_23449

GO 1200R20

AZ0083

CHI

1.00

1,000.00

DONE

7

SUM

1,920.00

8

1

15/09/2023

BSTR_23450

BS 1200R20

G580

JAP

9.00

1,800.00

16,200.00

DONE

9

2

15/09/2023

BSTR_23450

BS 1200R20

G580

THI

9.00

1,800.00

16,200.00

DONE

10

3

15/09/2023

BSTR_23450

BS 1200R20

R187

THI

10.00

1,800.00

18,000.00

11

SUM

50,400.00

12

1

16/09/2023

BSTR_23452

BS 1200R20

G580

JAP

4.00

1,800.00

7,200.00

DONE

13

SUM

7,200.00

14

1

16/09/2023

BSTR_23453

BS 1200R20

G580

JAP

3.00

1,880.00

5,640.00

DONE

15

SUM

5,640.00

SV

also result in SR sheet bases on RS sheet with the same way as I did it in SV sheet.
expected data in SV,SR sheets contain 8500 rows .
thanks

DanteAmor · Sep 23, 2024

If you had more than 2 pairs of sheets, you can place them in this line of the macro:

VBA Code:

ary = Array("SV", "VS", "SR", "RS")

Try this:

VBA Code:

Sub match_columns()
  'Match three columns together across sheet to subtraction based invoice number
  Dim dic As Object
  Dim a() As Variant, b() As Variant, c() As Variant, ary As Variant, ky As Variant, invNo As Variant
  Dim i As Long, j As Long, k As Long, m As Long, nRow As Long
  
  ary = Array("SV", "VS", "SR", "RS")
  
  For k = 0 To UBound(ary) Step 2
    Erase a, b
    Set dic = CreateObject("Scripting.Dictionary")
    a = Sheets(ary(k)).Range("A1:J" & Sheets(ary(k)).Range("A" & Rows.Count).End(3).Row).Value
    b = Sheets(ary(k + 1)).Range("A1:J" & Sheets(ary(k + 1)).Range("A" & Rows.Count).End(3).Row).Value
    ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
    
    For i = 2 To UBound(a)
      ky = a(i, 3) & "|" & a(i, 4) & "|" & a(i, 5) & "|" & a(i, 6)
      dic(ky) = i
    Next
    
    For i = 2 To UBound(b)
      If InStr(1, b(i, 10), " ") > 0 Then
        invNo = Split(b(i, 10), " ")
        ky = Trim(invNo(UBound(invNo))) & "|" & b(i, 4) & "|" & b(i, 5) & "|" & b(i, 6)
        If dic.exists(ky) Then
          nRow = dic(ky)
          a(nRow, 7) = a(nRow, 7) - b(i, 7)
          a(nRow, 9) = a(nRow, 9) - b(i, 9)
          a(nRow, 10) = "DONE"
          For j = nRow + 1 To UBound(a)
            If a(j, 1) = "SUM" Then
              a(j, 9) = a(j, 9) - b(i, 9)
              Exit For
            End If
          Next
        End If
      End If
    Next
    
    m = 0
    For i = 1 To UBound(a, 1)
      If a(i, 9) <> 0 Then
        m = m + 1
        For j = 1 To UBound(a, 2)
          c(m, j) = a(i, j)
        Next
      End If
    Next
    
    With Sheets(ary(k))
      .Range("A2").Resize(UBound(c, 1)).Interior.ColorIndex = xlColorIndexNone
      .Range("A1").Resize(UBound(c, 1), UBound(c, 2)).Value = c
      Application.ReplaceFormat.Clear
      Application.ReplaceFormat.Interior.Color = 8696052
      .Range("A:A").Replace "SUM", "SUM", xlPart, xlByRows, False, False, ReplaceFormat:=True
      Application.ReplaceFormat.Clear
    End With
  Next
End Sub

abdo meghari · Sep 23, 2024

awesome!
but I need fixing subtraction repeatedly when run every time the macro.

should put word DONE in column J for adjacant ID cells to avoid subtraction every time repeatedly(meaning when there is DONE word shouldn't do any thing)

doesn't seem to be clear for you .
ok I meant when there is DONE word for each ID after run the macro from first time and try run the macro every time for just DONE word then stop subtraction to avoid subtraction every time repeatedly and gives wrong calculation .
also in ITEM for column A and when delete entire row for ID contains the same QTY and delete it ,then should re-auto-numbering before SUM row like 1,2 instead of keep old number in column A .
thanks.

DanteAmor · Sep 23, 2024

abdo meghari said:
but I need fixing subtraction repeatedly when run every time the macro.

I forgot that part.

Try this:

VBA Code:

Sub match_columns()
  'Match three columns together across sheet to subtraction based invoice number
  Dim dic As Object
  Dim a() As Variant, b() As Variant, c() As Variant, ary As Variant, ky As Variant, invNo As Variant
  Dim i As Long, j As Long, k As Long, m As Long, n As Long, nRow As Long
  
  ary = Array("SV", "VS", "SR", "RS")
  
  For k = 0 To UBound(ary) Step 2
    Erase a, b
    Set dic = CreateObject("Scripting.Dictionary")
    a = Sheets(ary(k)).Range("A1:J" & Sheets(ary(k)).Range("A" & Rows.Count).End(3).Row).Value
    b = Sheets(ary(k + 1)).Range("A1:J" & Sheets(ary(k + 1)).Range("A" & Rows.Count).End(3).Row).Value
    ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
    
    For i = 2 To UBound(a)
      If a(i, 10) <> "DONE" Then
        ky = a(i, 3) & "|" & a(i, 4) & "|" & a(i, 5) & "|" & a(i, 6)
        dic(ky) = i
      End If
    Next
    
    For i = 2 To UBound(b)
      If InStr(1, b(i, 10), " ") > 0 Then
        invNo = Split(b(i, 10), " ")
        ky = Trim(invNo(UBound(invNo))) & "|" & b(i, 4) & "|" & b(i, 5) & "|" & b(i, 6)
        If dic.exists(ky) Then
          nRow = dic(ky)
          a(nRow, 7) = a(nRow, 7) - b(i, 7)
          a(nRow, 9) = a(nRow, 9) - b(i, 9)
          a(nRow, 10) = "DONE"
          For j = nRow + 1 To UBound(a)
            If a(j, 1) = "SUM" Then
              a(j, 9) = a(j, 9) - b(i, 9)
              Exit For
            End If
          Next
        End If
      End If
    Next
    
    m = 0
    n = 0
    For i = 1 To UBound(a, 1)
      If a(i, 9) <> 0 Then
        m = m + 1
        n = n + 1
        If a(i, 1) = "ITEM" Or a(i, 1) = "SUM" Then
          c(m, 1) = a(i, 1)
          n = 0
        Else
          c(m, 1) = n
        End If
        
        For j = 2 To UBound(a, 2)
          c(m, j) = a(i, j)
        Next
      End If
    Next
    
    With Sheets(ary(k))
      .Range("A2").Resize(UBound(c, 1)).Interior.ColorIndex = xlColorIndexNone
      .Range("A1").Resize(UBound(c, 1), UBound(c, 2)).Value = c
      Application.ReplaceFormat.Clear
      Application.ReplaceFormat.Interior.Color = 8696052
      .Range("A:A").Replace "SUM", "SUM", xlPart, xlByRows, False, False, ReplaceFormat:=True
      Application.ReplaceFormat.Clear
    End With
  Next
End Sub

abdo meghari · Sep 23, 2024

Perfect !
I have strange case !
sometimes when delete some row for ID will change formatting in font as in row 11,13

Abdoda.xlsm

A

B

C

D

E

F

G

H

I

J

1

ITEM

DATE

INV.NO

BRAND

TYPE

ORIGIN

QTY

PRICE

TOTAL

2

1

15/06/2023

BSTR_23448

BS 750R16

R230

JAP

3.00

500.00

1,500.00

DONE

3

2

15/06/2023

BSTR_23448

BS 700R16

R230

JAP

2.00

400.00

800.00

4

SUM

2,300.00

5

1

15/09/2023

BSTR_23449

GO 1200R20

AZ0026

CHI

1.00

920.00

6

2

15/09/2023

BSTR_23449

GO 1200R20

AZ0083

CHI

1.00

1,000.00

DONE

7

SUM

1,920.00

8

1

15/09/2023

BSTR_23450

BS 1200R20

G580

THI

9.00

1,800.00

16,200.00

DONE

9

2

15/09/2023

BSTR_23450

BS 1200R20

R187

THI

9.00

1,800.00

16,200.00

DONE

10

SUM

32,400.00

11

1

16/09/2023

BSTR_23452

BS 1200R20

G580

JAP

4.00

1,800.00

7,200.00

DONE

12

SUM

7,200.00

13

1

16/09/2023

BSTR_23453

BS 1200R20

G580

JAP

3.00

1,880.00

5,640.00

DONE

14

SUM

5,640.00

SV

do you have any idea why do that?

DanteAmor · Sep 23, 2024

abdo meghari said:
sometimes when delete some row for ID will change formatting in font as in row 11,13

do you have any idea why do that?

Those rows (11, 13) before the macro had a "SUM" row, so that is the format of rows 11 and 13.

Recommendation: Put the format you want in all the columns, since the macro does not remove or add formats to the columns, except for column A, since the "SUM" can move.

abdo meghari · Sep 24, 2024

may you check file please?
just click button and show how change font formatting.
Dropbox

DanteAmor · Sep 24, 2024

I can't download files.

As I told you, before running the macro, set the format you want for the entire column for each column.

And try again the macro.

abdo meghari · Sep 24, 2024

What is the problem?

the same thing

DECREASE.xlsm

A

B

C

D

E

F

G

H

I

J

1

ITEM

DATE

INV.NO

BRAND

TYPE

ORIGIN

QTY

PRICE

TOTAL

2

1

15/06/2023

BSTR_23448

BS 750R16

R230

JAP

2.00

500.00

1,000.00

DONE

3

2

15/06/2023

BSTR_23448

BS 700R16

R230

JAP

2.00

400.00

800.00

4

SUM

1,800.00

5

1

15/09/2023

BSTR_23449

GO 1200R20

AZ0026

CHI

1.00

920.00

6

2

15/09/2023

BSTR_23449

GO 1200R20

AZ0083

CHI

1.00

1,000.00

7

SUM

1,920.00

8

1

15/09/2023

BSTR_23450

BS 1200R20

G580

JAP

9.00

1,800.00

16,200.00

9

2

15/09/2023

BSTR_23450

BS 1200R20

R187

THI

10.00

1,800.00

18,000.00

10

SUM

34,200.00

11

1

16/09/2023

BSTR_23452

BS 1200R20

G580

JAP

3.00

1,800.00

5,400.00

DONE

12

SUM

5,400.00

13

1

16/09/2023

BSTR_23453

BS 1200R20

G580

JAP

1.00

1,880.00

DONE

14

SUM

1,880.00

15

1

16/09/2023

BSTR_23455

BS 1200R20

G580

JAP

3.00

1,900.00

5,700.00

16

SUM

5,700.00

17

SV

If it is a format, as I told you, before running the macro, set the format you want for the entire column for each column.

yes I did it by select all of columns for all of sheets and set the formatting ,that's why I attached file.

DanteAmor · Sep 24, 2024

I added the formatting setting, in this part, Just set the name of the font you want.

Rich (BB code):

      'format cells
      With .Range("A:J")
        .HorizontalAlignment = xlCenter
        .Font.Size = 14
        .Font.Name = "Arial"        'set your favorite font name
      End With
      .Range("G:I").NumberFormat = "#,##0.00"

Try:

VBA Code:

Sub match_columns()
  'Match three columns together across sheet to subtraction based invoice number
  Dim dic As Object
  Dim a() As Variant, b() As Variant, c() As Variant, ary As Variant, ky As Variant, invNo As Variant
  Dim i As Long, j As Long, k As Long, m As Long, n As Long, nRow As Long
  Application.ScreenUpdating = False
  
  ary = Array("SV", "VS", "SR", "RS")
  
  For k = 0 To UBound(ary) Step 2
    Erase a, b
    Set dic = CreateObject("Scripting.Dictionary")
    a = Sheets(ary(k)).Range("A1:J" & Sheets(ary(k)).Range("A" & Rows.Count).End(3).Row).Value
    b = Sheets(ary(k + 1)).Range("A1:J" & Sheets(ary(k + 1)).Range("A" & Rows.Count).End(3).Row).Value
    ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
    
    For i = 2 To UBound(a)
      If a(i, 10) <> "DONE" Then
        ky = a(i, 3) & "|" & a(i, 4) & "|" & a(i, 5) & "|" & a(i, 6)
        dic(ky) = i
      End If
    Next
    
    For i = 2 To UBound(b)
      If InStr(1, b(i, 10), " ") > 0 Then
        invNo = Split(b(i, 10), " ")
        ky = Trim(invNo(UBound(invNo))) & "|" & b(i, 4) & "|" & b(i, 5) & "|" & b(i, 6)
        If dic.exists(ky) Then
          nRow = dic(ky)
          a(nRow, 7) = a(nRow, 7) - b(i, 7)
          a(nRow, 9) = a(nRow, 9) - b(i, 9)
          a(nRow, 10) = "DONE"
          For j = nRow + 1 To UBound(a)
            If a(j, 1) = "SUM" Then
              a(j, 9) = a(j, 9) - b(i, 9)
              Exit For
            End If
          Next
        End If
      End If
    Next
    
    m = 0
    n = 0
    For i = 1 To UBound(a, 1)
      If a(i, 9) <> 0 Then
        m = m + 1
        n = n + 1
        If a(i, 1) = "ITEM" Or a(i, 1) = "SUM" Then
          c(m, 1) = a(i, 1)
          n = 0
        Else
          c(m, 1) = n
        End If
        
        For j = 2 To UBound(a, 2)
          c(m, j) = a(i, j)
        Next
      End If
    Next
    
    With Sheets(ary(k))
      .Range("A2").Resize(UBound(c, 1)).Interior.ColorIndex = xlColorIndexNone
      .Range("A1").Resize(UBound(c, 1), UBound(c, 2)).Value = c
      
      'format cells
      With .Range("A:J")
        .HorizontalAlignment = xlCenter
        .Font.Size = 14
        .Font.Name = "Arial"        'set your favorite font name
      End With
      .Range("G:I").NumberFormat = "#,##0.00"
      
      Application.ReplaceFormat.Clear
      Application.ReplaceFormat.Interior.Color = 8696052
      .Range("A:A").Replace "SUM", "SUM", xlPart, xlByRows, False, False, ReplaceFormat:=True
      Application.ReplaceFormat.Clear
      .Range("K:L").EntireColumn.AutoFit
      'end format cells
    End With
    
  Next
  Application.ScreenUpdating = True
End Sub

Match three columns together across sheet to subtraction based invoice number

abdo meghari

Well-known Member

Excel Facts

DanteAmor

Well-known Member

abdo meghari

Well-known Member

DanteAmor

Well-known Member

abdo meghari

Well-known Member

DanteAmor

Well-known Member

abdo meghari

Well-known Member

DanteAmor

Well-known Member

abdo meghari

Well-known Member

DanteAmor

Well-known Member

Similar threads

Forum statistics

Share this page

Match three columns together across sheet to subtraction based invoice number

Well-known Member

Excel Facts

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock