Populate calculated values from other sheets into new sheet

Question

I have excel which contains four sheets (say sheet1, sheet2, sheet3 and sheet4). I want to populate calculated values and other information from (sheet1, sheet2, sheet3) to sheet4. Both sheet1, sheet2 contains ID,Name, Age, Amount whereas sheet1 is static page and sheet2 is dynamic page. sheet3 will have ID, Name, Age, Contribution. once all these values are entered sheet4 should populate ID, Name, Age, Total(Amount * Contribution).

Sheet 1:

+--------------------------+
| ID | Name | Age | Amount |
+--------------------------+
| 1  | AAAA | 20  | 1500   |
+--------------------------+
| 2  | BBBB | 21  | 2000   |
+--------------------------+
| 3  | CCCC | 25  | 6000   |
+--------------------------+

Sheet 2:

+--------------------------+
| ID | Name | Age | Amount |
+--------------------------+
| 4  | XXXY | 20  | 3000   |
+--------------------------+
| 7  | YYYY | 21  | 7000   |
+--------------------------+
| 9  | ZZZZ | 25  | 5000   |
+--------------------------+

Sheet 3:

This sheet contribution value will be entered by user and they randomly enter for any user from both of the sheets (sheet1 or sheet2)

+------------------------------+
| ID | Name | Age | Contribute |
+------------------------------+
| 1  | AAAA | 20  | 1          |
+------------------------------+
| 3  | CCCC | 25  | 8          |
+------------------------------+
| 7  | YYYY | 21  | 9          |
+------------------------------+
| 9  | ZZZZ | 25  | 10         |
+------------------------------+

Sheet 4:

This should be auto populate the ID, Name and Age from Sheet3 exactly and Values should be Amount * Contribution (Amount my come from sheet1 or sheet2 based on the ID)

+------------------------------+
| ID | Name | Age | Value      |
+------------------------------+
| 1  | AAAA | 20  | 1500       |
+------------------------------+
| 3  | CCCC | 25  | 48000      |
+------------------------------+
| 7  | YYYY | 21  | 63000      |
+------------------------------+
| 9  | ZZZZ | 25  | 50000      |
+------------------------------+

@braX I am new to VBA and i am also trying with small source of knowledge. — Vignesh Kumar A
Does the "Sheet3" contribution is unique per ID, or it needs to be summarized for more possible occurrences? I mean, are there more (the same) IDs with different contributions which to be summarized? — FaneDuru
@FaneDuru Yes "Sheet3" contribution is unique per ID. Only one ID will come in "Sheet3" either it from "Sheet1" or "Sheet2" — Vignesh Kumar A

FaneDuru FaneDuru · Accepted Answer · 2020-06-25T13:36:32

Try the next code, please. It must be copied in the dummy "Sheet4" module.

You must replace "Sheet1_", "Sheet2_", "Sheet3_" sheet names with your real ones. It will also clear all records for a deleted ID:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Column = 1 Then
        Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, IDCell As Range
        Dim dContrib As Double, dAmount As Double
        
        Set sh1 = Worksheets("Sheet1_"): Set sh2 = Worksheets("Sheet2_")
        Set sh3 = Worksheets("Sheet3_")
        
        Set IDCell = sh3.Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole)
        If Not IDCell Is Nothing Then
            If Target.Value <> "" Then
                Target.Offset(0, 1).Value = IDCell.Offset(0, 1).Value
                Target.Offset(0, 2).Value = IDCell.Offset(0, 2).Value
                If IsNumeric(IDCell.Offset(0, 3).Value) Then
                     dContrib = IDCell.Offset(0, 3).Value
                Else
                    'for the case of writing the ID header...
                    Target.Offset(0, 3).Value = "Value"
                    Exit Sub
                End If
            End If
        Else
            MsgBox """" & Target.Value & """ ID could not be found...": Target.Activate
            Exit Sub
        End If
        Set IDCell = sh1.Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole)
        If Not IDCell Is Nothing Then
            If Target.Value <> "" Then
                dAmount = IDCell.Offset(0, 3).Value
                Target.Offset(0, 3).Value = dAmount * dContrib: Exit Sub
            End If
        End If
         Set IDCell = sh2.Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole)
        If Not IDCell Is Nothing Then
            If Target.Value <> "" Then
                dAmount = IDCell.Offset(0, 3).Value
                Target.Offset(0, 3).Value = dAmount * dContrib: Exit Sub
            End If
        End If
        If Target.Value <> "" Then
            MsgBox """" & Target.Value & """ ID could not be found...": Target.Activate
        Else
            Target.Offset(0, 1).ClearContents: Target.Offset(0, 2).ClearContents
            Target.Offset(0, 3).ClearContents
        End If
   End If
End Sub

After edit:

Please, use the next code. Paste the next code in the Click event of your button existing on Sheet3:

Private Sub MyButton_Click()
    Dim sh1 As Worksheet, sh2 As Worksheet, sh As Worksheet, sh4 As Worksheet
    Dim dContrib As Double, dAmount As Double, IDCell As Range, Target As Range
    Dim lastRow As Long, rngCopy As Range, i As Long
        
    Set sh1 = Worksheets("Sheet1_"): Set sh2 = Worksheets("Sheet2_")
    Set sh = ActiveSheet: Set sh4 = Worksheets("Sheet4_")
        
    'Clear all the content of Sheet4, except its headers first row:
    sh4.Range("A2:D" & sh4.Range("A" & Rows.Count).End(xlUp).row).ClearContents
        
    'Copy all data from the first three columns of Sheet3:
    Set rngCopy = sh.Range("A2:C" & sh.Range("A" & Rows.Count).End(xlUp).row)
    sh4.Range("A2").Resize(rngCopy.Rows.Count, rngCopy.Columns.Count).Value = rngCopy.Value
        
    'Iterate between all existing IDs and process the data:
    lastRow = sh4.Range("A" & Rows.Count).End(xlUp).row
    For i = 2 To lastRow
        Set Target = sh.Range("A" & i) 'ID to be processed
        dContrib = Target.Offset(0, 3).Value 'Amount
             
        Set IDCell = sh1.Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole)
        If Not IDCell Is Nothing Then
            If Target.Value <> "" Then
                dAmount = IDCell.Offset(0, 3).Value
                sh4.Range("D" & i).Value = dAmount * dContrib
            End If
        Else
            Set IDCell = sh2.Range("A:A").Find(What:=Target.Value, LookAt:=xlWhole)
            If Not IDCell Is Nothing Then
                If Target.Value <> "" Then
                    dAmount = IDCell.Offset(0, 3).Value
                    sh4.Range("D" & i).Value = dAmount * dContrib
                End If
            End If
        End If
        Next i
        sh4.Activate 'activate the processed sheet, in order to see the result
End Sub

Populate calculated values from other sheets into new sheet

2 Answers