Previous Topic Next Topic

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

Solved/Closed
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021 - Jun 2, 2021 at 06:46 AM
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021 - Aug 18, 2021 at 04:57 AM
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
Related:

9 responses

Answer 1 / 9
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Jun 17, 2021 at 12:12 PM
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
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Jun 19, 2021 at 04:43 AM
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
0
Answer 2 / 9
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Jun 29, 2021 at 11:43 AM
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
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Updated on Jun 30, 2021 at 04:42 AM
Hi Trowa,
it gives error "OVERFLOW" in this line 
lRow = .Range("A1").End(xlDown).Row + 1

Best regards,
KalilMe
0
Answer 3 / 9
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Aug 17, 2021 at 11:32 AM
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
Answer 4 / 9
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Jun 3, 2021 at 12:27 PM
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
0
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Updated on Jun 3, 2021 at 04:40 PM
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
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555 > kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Jun 8, 2021 at 12:11 PM
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
0

Didn't find the answer you are looking for?

Ask a question
Answer 5 / 9
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Updated on Jun 8, 2021 at 04:58 PM
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
0
Answer 6 / 9
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Jun 21, 2021 at 11:27 AM
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
0
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Jun 24, 2021 at 10:07 AM
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
0
Answer 7 / 9
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Jul 1, 2021 at 11:16 AM
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
0
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Jul 3, 2021 at 03:45 AM
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
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555 > kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Jul 5, 2021 at 11:40 AM
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
0
Answer 8 / 9
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Updated on Jul 7, 2021 at 04:13 AM
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
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Jul 8, 2021 at 12:14 PM
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
0
Answer 9 / 9
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Aug 11, 2021 at 09:13 AM
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
0
kalilme Posts 10 Registration date Tuesday April 20, 2021 Status Member Last seen August 18, 2021
Aug 18, 2021 at 04:57 AM
thanks so much for your solution
0

Similar discussions

help me to add particular cells
mathewmunna -
mathew munna -

2 responses
How to calculate positions (1st,2nd,3rd...) in Excel
hardy -
TrowaD -

6 responses
How to calculate position (1st,2nd,3rd) in excel....?
abdulwajid -
TrowaD -

1 response
Calculation of positions in excel
Mohsin -
Dausayi -

12 responses