PDA

View Full Version : [SLEEPER:] Loop between two tables to sum their matches



Sohan2012
11-09-2022, 05:11 PM
Greetings, I am currently struggling with this code, you will see that you must find the matches through a loop between "Sourcetable" and "GoalTable" according to their ID, and add the values of the products that match, I am trying to apply the "Val function" but it does not work well, I am attentive to any contribution
303223031730323

Sohan2012
11-09-2022, 05:16 PM
Option Explicit


Sub CopyData()
Dim SrcTable As ListObject, GoalTable As ListObject
Dim SourceArr As Variant, ID As Variant, m As Variant
Dim i As Long

With ThisWorkbook
Set SrcTable = .Worksheets("SourceData").ListObjects("Source")
Set GoalTable = .Worksheets("GoalTable").ListObjects("Goal")
End With

SourceArr = SrcTable.DataBodyRange.Value

For i = 1 To UBound(SourceArr, xlRows)
ID = SourceArr(i, 1)
m = Application.Match(ID, GoalTable.ListColumns("ID").DataBodyRange, 0)
If Not IsError(m) Then
With GoalTable
.DataBodyRange(CLng(m), 3).Value = SourceArr(i, 3)
.DataBodyRange(CLng(m), 4).Value = SourceArr(i, 4)
End With
End If
Next i

End Sub

Bob Phillips
11-10-2022, 12:01 PM
Try this


Sub CopyData()
Dim SrcTable As ListObject, GoalTable As ListObject
Dim SourceArr As Variant, ID As Variant, m As Variant
Dim i As Long

With ThisWorkbook
Set SrcTable = .Worksheets("SourceData").ListObjects("Source")
Set GoalTable = .Worksheets("SourceData").ListObjects("Goal")
End With

SourceArr = SrcTable.DataBodyRange.Value

For i = 1 To UBound(SourceArr, xlRows)
ID = SourceArr(i, 1)
m = Application.Match(ID, GoalTable.ListColumns("ID").DataBodyRange, 0)
If Not IsError(m) Then
With GoalTable
.DataBodyRange(CLng(m), 3).Value = SourceArr(i, 3)
.DataBodyRange(CLng(m), 4).Value = SourceArr(i, 4)
End With
Else
GoalTable.ListRows.Add GoalTable.DataBodyRange.Rows.Count + 1
With GoalTable.DataBodyRange
.Cells(.Rows.Count, 1).Value = SourceArr(i, 1)
.Cells(.Rows.Count, 2).Value = SourceArr(i, 2)
.Cells(.Rows.Count, 3).Value = SourceArr(i, 3)
.Cells(.Rows.Count, 4).Value = SourceArr(i, 4)
End With
End If
Next i
End Sub

arnelgp
11-10-2022, 06:13 PM
you can also accomplished the same using VLookup. No VBA required.

Bob Phillips
11-13-2022, 01:24 PM
you can also accomplished the same using VLookup. No VBA required.

Very difficult with any new items though!