Merge data across multiple sheets in one sheet and calculate the values

[Solved]
Report
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021
-
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021
-
hi
I have data in multiple sheets the same structure some sheets have duplicated data
so it should merge and summing the values and show the result in sheet result and sometimes the data in sheet PURCHASE & SRETURNS are new then should highlight by blue color and highlight red color in sheet result an add to the bottom in sheet result and if I change or entering any data for any sheet then should update in sheet the result when I run the macro should brings all of data in sheet result with highlighting in the last row the formula should like this in COL E in sheet result =FIRST+ PURCHASE -SALES+SRETURNS-PRETURNS
I put a little data in first two rows and the three last rows to see how should the formula in last column E with brings all of data
attached file
https://easyupload.io/fst7aj

9 replies

Posts
2805
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 14, 2021
482
Hi Kalilme,

Here is a code to get you started. It will get you the totals on the RESULT sheet. Just make sure that the RESULT sheet contains all the products from the other sheets.

Sub RunMe()
Dim ws As Worksheet, mFind As Range

Sheets("RESULT").Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row).ClearContents

For Each ws In Worksheets
    If ws.Name <> "RESULT" Then
        ws.Select
        For Each cell In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
            Set mFind = Sheets("RESULT").Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Find(cell.Value)
            If Not mFind Is Nothing Then
                fAddress = mFind.Address
                Do
                    If mFind.Offset(0, 1).Value & mFind.Offset(0, 2).Value = cell.Offset(0, 1).Value & cell.Offset(0, 2).Value Then
                        If ws.Name = "SALES" Or ws.Name = "PRETURNS" Then
                            mFind.Offset(0, 3).Value = mFind.Offset(0, 3).Value - cell.Offset(0, 3).Value
                        Else
                            mFind.Offset(0, 3).Value = mFind.Offset(0, 3).Value + cell.Offset(0, 3).Value
                        End If
                    End If
                Set mFind = Sheets("RESULT").Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).FindNext(mFind)
                Loop While mFind.Address <> fAddress
            End If
        Next cell
    End If
Next ws
End Sub


Best regards,
Trowa
1
Thank you

Glad we were able to help! Love us? Write us a review! Rate CCM

CCM 2942 users have said thank you to us this month

Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

Hi Trowa ,
first thanks for your code , second I was wanting to create the whole of data in sheet summary .
it should not write the data manually and match among the sheets . it will take from me more time .
it should create the whole data in sheet SUMMARY without interfere from me , and what about highlight the data ?
Best regards,
kalilme
Posts
2805
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 14, 2021
482
Hi Kalilme,

Aha, so by 'new' you mean 'unique'. In my mind 'new' is time related.

Give this code a go and see if it meets your requirements:
Sub RunMe()
Dim ws As Worksheet, mFind As Range
Dim lRow As Integer
Dim mCheck As Boolean

Sheets("RESULT").Range("E2:E" & Range("E" & Rows.Count).End(xlUp).Row).ClearContents
Sheets("RESULT").Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone

For Each ws In Worksheets
    ws.Select
    If ws.Name <> "RESULT" Then
        Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone
        For Each cell In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
            mCheck = False
            With Sheets("RESULT")
                Set mFind = .Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Find(cell.Value)
                If Not mFind Is Nothing Then
                    fAddress = mFind.Address
                    Do
                        If mFind.Offset(0, 1).Value & mFind.Offset(0, 2).Value = cell.Offset(0, 1).Value & cell.Offset(0, 2).Value Then
                            mCheck = True
                            If ws.Name = "SALES" Or ws.Name = "PRETURNS" Then
                                mFind.Offset(0, 3).Value = mFind.Offset(0, 3).Value - cell.Offset(0, 3).Value
                            Else
                                mFind.Offset(0, 3).Value = mFind.Offset(0, 3).Value + cell.Offset(0, 3).Value
                            End If
                        End If
                        Set mFind = Sheets("RESULT").Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).FindNext(mFind)
                    Loop While mFind.Address <> fAddress
                End If
                If mCheck = False Then
                    lRow = .Range("A1").End(xlDown).Row + 1
                    .Range("A" & lRow).Value = Sheets("RESULT").Range("A" & lRow - 1).Value + 1
                    .Range("B" & lRow).Value = cell.Value
                    .Range("C" & lRow).Value = cell.Offset(0, 1).Value
                    .Range("D" & lRow).Value = cell.Offset(0, 2).Value
                    If ws.Name = "SALES" Or ws.Name = "PRETURNS" Then
                        .Range("E" & lRow).Value = cell.Offset(0, 3).Value * -1
                    Else
                        .Range("E" & lRow).Value = cell.Offset(0, 3).Value
                    End If
                    Range(Cells(cell.Row, "A"), Cells(cell.Row, "E")).Interior.ColorIndex = 33
                    .Select
                    .Range(Cells(lRow, "A"), Cells(lRow, "E")).Interior.ColorIndex = 3
                    ws.Select
                End If
            End With
        Next cell
    End If
Next ws
With Columns("A:E")
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Range("A1:E" & Range("A1").End(xlDown).Row)
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
End Sub


Best regards,
Trowa
1
Thank you

Glad we were able to help! Love us? Write us a review! Rate CCM

CCM 2942 users have said thank you to us this month

Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

Hi Trowa,
it gives error "OVERFLOW" in this line
lRow = .Range("A1").End(xlDown).Row + 1

Best regards,
KalilMe
Posts
2805
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 14, 2021
482
Hi Kalilme,

I really thought I posted the solution.

Hopefully you check back and see the code below:
Sub RunMe()
Dim ws As Worksheet, mFind As Range
Dim lRow As Integer
Dim mCheck As Boolean

Sheets("RESULT").Select
If Range("A2").Value <> vbNullString Then
    With Sheets("RESULT").Range("A2:E" & Range("E" & Rows.Count).End(xlUp).Row)
        .ClearContents
        .Interior.ColorIndex = xlNone
    End With
End If

For Each ws In Worksheets
    ws.Select
    If ws.Name <> "RESULT" Then
        Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Interior.ColorIndex = xlNone
        For Each cell In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
            mCheck = False
            With Sheets("RESULT")
                Set mFind = .Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Find(cell.Value)
                If Not mFind Is Nothing Then
                    fAddress = mFind.Address
                    Do
                        If mFind.Offset(0, 1).Value & mFind.Offset(0, 2).Value = cell.Offset(0, 1).Value & cell.Offset(0, 2).Value Then
                            mCheck = True
                            If ws.Name = "SALES" Or ws.Name = "PRETURNS" Then
                                mFind.Offset(0, 3).Value = mFind.Offset(0, 3).Value - cell.Offset(0, 3).Value
                            Else
                                mFind.Offset(0, 3).Value = mFind.Offset(0, 3).Value + cell.Offset(0, 3).Value
                            End If
                            If ws.Name = "PURCHASE" Or ws.Name = "SRETURNS" Then
                                If .Cells(mFind.Row, "F").Value = "Check" Then
                                    .Select
                                    .Range(Cells(mFind.Row, "A"), Cells(mFind.Row, "E")).Interior.ColorIndex = xlNone
                                Else
                                    .Cells(mFind.Row, "F").Value = "Check"
                                    .Select
                                    .Range(Cells(mFind.Row, "A"), Cells(mFind.Row, "E")).Interior.ColorIndex = 3
                                End If
                            End If
                            ws.Select
                        End If
                        Set mFind = Sheets("RESULT").Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).FindNext(mFind)
                    Loop While mFind.Address <> fAddress
                End If
                If mCheck = False Then
                    lRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    If lRow = 2 Then
                        .Range("A" & lRow).Value = 1
                    Else
                        .Range("A" & lRow).Value = Sheets("RESULT").Range("A" & lRow - 1).Value + 1
                    End If
                    .Range("B" & lRow).Value = cell.Value
                    .Range("C" & lRow).Value = cell.Offset(0, 1).Value
                    .Range("D" & lRow).Value = cell.Offset(0, 2).Value
                    If ws.Name = "SALES" Or ws.Name = "PRETURNS" Then
                        .Range("E" & lRow).Value = cell.Offset(0, 3).Value * -1
                    Else
                        .Range("E" & lRow).Value = cell.Offset(0, 3).Value
                    End If
                    If ws.Name = "PURCHASE" Or ws.Name = "SRETURNS" Then
                        .Cells(lRow, "F").Value = "Check"
                        .Select
                        .Range(Cells(lRow, "A"), Cells(lRow, "E")).Interior.ColorIndex = 3
                    End If
                    ws.Select
                End If
            End With
        Next cell
    End If
Next ws
With Columns("A:E")
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Range("A1:E" & Range("A1").End(xlDown).Row)
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With

For Each cell In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)
    If cell.Interior.ColorIndex = 3 Then
        Sheets("PURCHASE").Select
        Set mFind = Sheets("PURCHASE").Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Find(cell.Value)
        If Not mFind Is Nothing Then
            fAddress = mFind.Address
            Do
                If mFind.Offset(0, 1).Value & mFind.Offset(0, 2).Value = cell.Offset(0, 1).Value & cell.Offset(0, 2).Value Then
                    Sheets("PURCHASE").Range(Cells(mFind.Row, "A"), Cells(mFind.Row, "E")).Interior.ColorIndex = 33
                End If
                Set mFind = Sheets("PURCHASE").Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).FindNext(mFind)
            Loop While mFind.Address <> fAddress
        End If
        Sheets("SRETURNS").Select
        Set mFind = Sheets("SRETURNS").Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).Find(cell.Value)
        If Not mFind Is Nothing Then
            fAddress = mFind.Address
            Do
                If mFind.Offset(0, 1).Value & mFind.Offset(0, 2).Value = cell.Offset(0, 1).Value & cell.Offset(0, 2).Value Then
                    Sheets("SRETURNS").Range(Cells(mFind.Row, "A"), Cells(mFind.Row, "E")).Interior.ColorIndex = 33
                End If
                Set mFind = Sheets("SRETURNS").Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row).FindNext(mFind)
            Loop While mFind.Address <> fAddress
        End If
    End If
Next cell
Sheets("RESULT").Select
Columns("F").ClearContents
End Sub


Best regards,
Trowa
1
Thank you

Glad we were able to help! Love us? Write us a review! Rate CCM

CCM 2942 users have said thank you to us this month

Posts
2805
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 14, 2021
482
Hi Kalilme,

I don't understand your logic for highlighting new entries. What is considered new? On sheet "Purchase" you have on entry for 25-2 which is considered new and is blue, but on sheet "Sales" you have on entry for 25-2 which apparently is not new as it is not blue.

Is there a condition for the highlights to be non-highlighted?

I also don't understand the calculation FIRST+ PURCHASE - SALES + SRETURNS - PRETURNS. When I look at the value for Banana SO across the sheet respectively, I get:
100 + 330 - 40 + 10 - 45 = 355
Yet your sheet "Result" shows 255. Did you just forgot the value from sheet "First"?

Best regards,
Trowa
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

Hi Trowa,
sorry if I make confusion for you let me start where you finished because this part is the most important , I no know how I forgot it sorry I lost my focus , yes you're right the right value should be 355 , as for the data are highlighted because theses are new the highlighted should only new data
then also you're right on sheet "Sales" entry for 25-2 which apparently should be blue and the same data should not be necessarily to be existed in another sheet
finally I would add another detail my real data are at least 3000 across multiple sheets and it may increasable continuously
I hope this help
Posts
2805
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 14, 2021
482 >
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

Hi Kalilme,

Ok, that clarifies the calculation part.

I still can't figure out what makes an entry "new" though.
On the "Purchase" sheet you have 2 dates considered new; 24-2 and 25-2, so it's not a single date.
On the "Sreturns" sheet you have a new entry with the date 24-3, which is a whole lot "newer" (later).

How would you define "new"?

Best regards,
Trowa
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

Hi Trowa,
of course the date is different because the data occurs daily , the new entry data specifies from COL A: COL E together so when fill data from COL A: COL E then should automatically show in sheet result and calculate , and if the data are existed in COLB,C,D are repeated then should merge , if you see in sheet result you will note merge and calculate duplicated data in COL B,C,D together
note: but sometimes changes data in sheet purchase or sheet sreturns has already existed then should change in sheet result
I hope this help
Posts
2805
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 14, 2021
482
Hi Kalilme,

'it should create the whole data in sheet SUMMARY without interfere from me'
Ok.

'what about highlight the data'
It is still unclear to me what the condition is to highlight certain rows.

Best regards,
Trowa
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

Hi Trowa ,
about highlight the data in sheet PURCHASE & SRETURNS . the standards should see to COL B,C,D together if there are the same data after matching in the same sheet then shouldn't highlight them , and if there are different then should highlighted , and when merge data in sheet result should also highlight the same data are highlighted in sheet PURCHASE & SRETURNS .
I hope this help
Posts
2805
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 14, 2021
482
Hi KalilMe,

Then you got quit some data. Change the 3rd code line:
Dim lRow As Integer

into
Dim lRow as Long


Best regards,
Trowa
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

Hi Trowa,
I changed and gives me another error "application-defined or object - defined error" in this line
 .Range("A" & lRow).Value = Sheets("RESULT").Range("A" & lRow - 1).Value + 1


Best regards,
Kalilme
Posts
2805
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 14, 2021
482 >
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

Hi Kalilme,

It seems your result sheet is empty (except for the header), which is not what I anticipated as per your sample data.

That would explain the 2 errors you got.

Replace the code lines 32 and 33:
lRow = .Range("A1").End(xlDown).Row + 1
.Range("A" & lRow).Value = Sheets("RESULT").Range("A" & lRow - 1).Value + 1

with:
lRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
If lRow = 2 Then
    .Range("A" & lRow).Value = 1
Else
    .Range("A" & lRow).Value = Sheets("RESULT").Range("A" & lRow - 1).Value + 1
End If


Code line 32: When A2 is empty, the previous code line would set the first available row at the bottom of the sheet, which would exceed the integer value set to lRow. Setting lRow to Long would solve this, but isn't necessary anymore with the amended code lines.
Code line 33: When A2 is empty, the previous code line tries to add 1 to the value of the A1, which is a string, thus producing an error.

Best regards,
Trowa
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

Hi Trowa,
normally , the sheet RESULT is empty because I said it should create the whole data in sheet SUMMARY without interfere from me (this mean should create the summary with the headers without write any thing in sheet RESULT . the code should do every thing .
by the way I cleared all of data and test the code, also I write the headers and test the code but it highlight all of data in sheet FIRST and sheet RESULT . so can you guide me how the code works, please?
sheet first



sheet RESULT
Posts
2805
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 14, 2021
482
Hi Kalilme,

Yeah, it colors everything, because all the data is considered new as they are not found on the RESULT sheet. When you run the code again, you will notice that all the highlights will be removed.
After that, when you add another row on any of the sheets other then the RESULT sheet, where the combi of values in column B,C,D are not found on the RESULT sheet, then that row will be highlighted as well as the newly added row on the RESULT sheet. This was my understanding as how you wanted it, so you can easily see if a products appears on the RESULT sheet for the first time. Guess I was wrong...

Reading the 8th post again.
So only sheets PURCHASE and SRETURNS are eligable for highlights. A row on these 2 sheets should be highlighted when the combi of values from columns B,C,D are unique (only appear once). Then highlight the matching row on the RESULT sheet.

Do let me know if this is how it should work as your sample file doesn't show this. In your sample file on the PURCHASE sheet, only the bottom 2 rows (25 and 26) are highlighted, but shouldn't rows 14 to 26 be highlighted?

Ah, if sheets PURCHASE and SRETURNS are seen as one list, then it makes sense. I think I got it. I will get to it next week.

Best regards,
Trowa
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

hi Trowa ,
I hope to don't forget completing your favor. it remains problem the highlighted rows,
otherwise everything is good . I would close this subject and mark solved to the others members take advantage from this subject in the future.
best regards,
Kalilme
Posts
11
Registration date
Tuesday April 20, 2021
Status
Member
Last seen
August 18, 2021

thanks so much for your solution