How to import data to cells that contain data and SUM the two values

chipsworld

Board Regular
Joined
May 23, 2019
Messages
153
Office Version
  1. 365
All,
Thanks to GlennUK, I have gotten this far, but am now perplexed...

Using "Find" to import the data to multiple columns and rows was a great idea, but now I need to import additional data to those same ranges and sum it with what is already there...

How? I have been trying to figure this out for a couple of days now with no luck... Any help would be awesome!

Here is what I have thus far...

As you can see, I allow the user to select the file which contains the data (SourceW), then import it to the master sheet (TargetW). However, I need to import additional data to a few of the ranges in TargetW (Ranges defined as Tar) and add the additional numbers to the data values already in those ranges.

VBA Code:
Private Sub cmdImport_Click()
Dim filter As String
Dim caption As String
Dim SourceF As String
Dim SourceW As Workbook
Dim TargetW As Workbook
Dim SourceS As Worksheet
Dim TargetS As Worksheet



On Error Resume Next

Set TargetW = Application.ThisWorkbook

' get the customer workbook
filter = "*.xl* (*.xls*),*.xls*"
caption = "Please Select file to import "
SourceF = Application.GetOpenFilename(filter, , caption)

Set SourceW = Application.Workbooks.Open(SourceF)

Set TargetS = TargetW.Sheets("AAR")

Set SourceS = SourceW.Worksheets("AAR")


Dim c As Range
Dim Tar As Range
Dim Src As Range


Set TargetS = ThisWorkbook.Worksheets("AAR")

If cmdSection.Value = "S1 Mobilization" Then
Set Tar = TargetS.Range("A5:A59")
Set Src = SourceS.Range("A5:A59")
ElseIf cmdSection.Value = "S1 Administration" Then
Set Tar = TargetS.Range("A63:A96")
Set Src = SourceS.Range("A63:A96")
ElseIf cmdSection.Value = "S1 DEMOB Individuals" Then
Set Tar = TargetS.Range("A102:A132")
Set Src = SourceS.Range("A102:A132")
ElseIf cmdSection.Value = "S1 DEMOB Units" Then
Set Tar = TargetS.Range("A137:A181")
Set Src = SourceS.Range("A137:A181")
ElseIf cmdSection.Value = "CRC" Then
Set Tar = TargetS.Range("A185:A234")
Set Src = SourceS.Range("A185:A234")
End If

For Each c In Tar ' Tar = Target Range defined above
Set myres = Src.Find(c.Value)
If Not myres Is Nothing Then
c.Offset(0, 2).Resize(1, 7).Value = myres.Offset(0, 2).Resize(1, 7).Value
End If
Next
   



ThisWorkbook.Sheets("AAR").Activate = True
SourceW.Close SaveChanges:=False



End Sub
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
I think you're asking how to sum values in columns C:I from a source sheet to a destination sheet, only when the row number and cell value in column A matches in both sheets.

Debugged, but untested, recommend saving copy of your Target file first.

However, replace all of your code with below and try:
VBA Code:
Private Sub cmdImport_Click()
        
    Dim Src As Variant

    With Application
        On Error GoTo EndMe
        Src = Source_Values(cmdSection.Value, .Workbooks.Open(.GetOpenFilename("*.xls* (*.xls*), *.xls*", , "Select File to Import"), , True)).Value
        On Error GoTo 0
    End With

    Aggregate Src, Source_Values(cmdSection.Value)
    Erase Src
    Exit Sub

EndMe
    Erase Src
End Sub

Private Function Source_Values(ByRef xStr As String, Optional ByRef wkb As Workbook = Nothing) As Range
      
    If wkb Is Nothing Then Set wkb = ThisWorkbook
     
    With wkb
        With .Sheets("AAR")
            Select Case xStr
                Case "S1 Mobilization": Set Source_Values = .[A5:I59]
                Case "S1 Administration": Set Source_Values = .[A63:I96]
                Case "S1 DEMOB Individuals": Set Source_Values = .[A102:I132]
                Case "S1 DEMOB Units": Set Source_Values = .[A137:I181]
                Case "CRC": Set Source_Values = .[A185:I234]
                Case Else
            End Select
        End With
        If .Name <> ThisWorkbook.Name Then .Close
    End With
      
    Set wkb = Nothing
  
End Function

Private Sub Aggregate(ByRef Src As Variant, ByRef Rng As Range)

    Dim x   As Long
    Dim y   As Long
    Dim Trg As Variant: Trg = Rng.Value

    For x = LBound(Src, 1) To UBound(Src, 1)
        If Trim$(Trg(x, 1)) = Trim$(Src(x, 1)) Then
            For y = LBound(Trg, 2) To UBound(Trg, 2)
                If InStr("2|3", CStr(y)) = 0 Then Trg(x, y) = Trg(x, y) + Src(x, y)
            Next y
        End If
    Next x

    Rng.Value = Trg
    Rng.Parent.Activate
    Erase Trg

End Sub
Expecting errors, so do include the line that is highlighted in yellow as well as the error message.
 
Last edited:
Upvote 0
JackDanice...

First of all...Thank you! Your code is definitely outside my normal level, and is kicking up some errors, but I am trying to figure it out, but...

My goal is... I import data from an external source workbook/sheet into my master.

Then, I need to import additional data into certain sections of the master and sum those numbers to what was already imported, so...

I.e. Import data to A1, then import more data to A1 and SUM with what was already in A1 for a new value in A1...

A1 being the various ranges I have defined.

I can tell you that the source wb/shts are exact copies of the master wb/shts. I am just using this as a tool to consolidate several individual reports into one to be sent up to mgmt.

Here is what I have gotten so far...
First Error - if I then eliminate the On Error line and the EndMe line, I get to here: 2nd Error with an Object Required error
 

Attachments

  • First Error.jpg
    First Error.jpg
    116.1 KB · Views: 5
  • 2nd Error.jpg
    2nd Error.jpg
    118.9 KB · Views: 4
Upvote 0
Replace just the first sub with:
VBA Code:
Private Sub cmdImport_Click()
        
    Dim s   As String
    Dim Src As Variant
    
    With Application
        On Error GoTo EndMe
        s = .GetOpenFilename("*.xls* (*.xls*), *.xls*", , "Select File to Import")
        Src = Source_Values(cmdSection.Value, .Workbooks.Open(s, , True)).Value
        On Error GoTo 0
    End With

    Aggregate Src, Source_Values(cmdSection.Value)
    Erase Src
    Exit Sub

EndMe:
End Sub
 
Upvote 0
OK...made the change...

Runs through sub. Gets to line:

s = .GetOpenFilename("*.xls* (*.xls*), *.xls*", , "Select File to Import")

then jumps to SOurce_Values Sub

then goes straight to cmdImport_Click - End Sub

Nothing imported...
 
Upvote 0
Looks like it is not setting the Src variant to the source workbook/sheet

Here is a link to the whole thing...Source and Master - Keep in mind that the source I am using is a consolidated form of the report. Each section will have a version of this file.

 
Upvote 0
With the files in the link, I got it to work by removing 1 line (was closing source file at wrong point in macro) and adding 1 line (clearing out variables due to adjustment for closing source file in correct part of code).

Try below, replacing all code suggested in #2:
VBA Code:
Private Sub cmdImport_Click()

    Dim s   As String
    Dim Src As Variant
    
    With Application
        On Error GoTo EndMe
        s = .GetOpenFilename("*.xls* (*.xls*), *.xls*", , "Select File to Import")
        Src = Source_Values(cmdSection.Value, .Workbooks.Open(s, , True)).Value
        On Error GoTo 0
    End With

    Aggregate Src, Source_Values(cmdSection.Value)
    Erase Src
    Exit Sub

EndMe:
End Sub

Private Function Source_Values(ByRef xStr As String, Optional ByRef wkb As Workbook = Nothing) As Range
      
    If wkb Is Nothing Then Set wkb = ThisWorkbook
     
    With wkb
        With .Sheets("AAR")
            Select Case xStr
                Case "S1 Mobilization": Set Source_Values = .[A5:I59]
                Case "S1 Administration": Set Source_Values = .[A63:I96]
                Case "S1 DEMOB Individuals": Set Source_Values = .[A102:I132]
                Case "S1 DEMOB Units": Set Source_Values = .[A137:I181]
                Case "CRC": Set Source_Values = .[A185:I234]
                Case Else
            End Select
        End With
    End With
      
    Set wkb = Nothing
  
End Function

Private Sub Aggregate(ByRef Src As Variant, ByRef Rng As Range)

    Dim x   As Long
    Dim y   As Long
    Dim Trg As Variant: Trg = Rng.Value

    For x = LBound(Src, 1) To UBound(Src, 1)
        If Trim$(Trg(x, 1)) = Trim$(Src(x, 1)) Then
            For y = LBound(Trg, 2) To UBound(Trg, 2)
                If InStr("2|3", CStr(y)) = 0 Then Trg(x, y) = Trg(x, y) + Src(x, y)
            Next y
        End If
    Next x

    Rng.Value = Trg
    Rng.Parent.Activate
    Erase Src: Erase Trg

End Sub

In addition, where you have code for sheet AAR in the master file, Right click on AAR and replace Private Sub cmdInput_Click() with below. It should centre the form for you:
VBA Code:
Private Sub cmdInput_Click()

    Dim xLeft   As Double
    Dim xTop    As Double

    With Application
        xLeft = .Left + 0.5 * .Width
        xTop = .Top + 0.5 * .Height
    End With

    With frmImport
        .cmdSection.AddItem "S1 Mobilization"
        .cmdSection.AddItem "S1 Administration"
        .cmdSection.AddItem "S1 DEMOB Individuals"
        .cmdSection.AddItem "S1 DEMOB Units"
        .cmdSection.AddItem "CRC"

        .Left = xLeft - 0.5 * .Width
        .Top = xTop - 0.5 * .Height
        .Show
    End With
    
End Sub
 
Upvote 0
Jack...
Not sure what I have done wrong, but not working...

It seems to run through everything clean, but the For loop in the Aggregate sub is not running. It looks like it is only loading the values from Col A

Did I miss something?

BTW: Thanks for that other tidbit. Always wondered if there was an easier way to center a form...

VBA Code:
Private Sub cmdImport_Click()

    Dim s   As String
Dim Src As Variant

With Application
On Error GoTo EndMe
s = .GetOpenFilename("*.xls* (*.xls*), *.xls*", , "Select File to Import")
Src = Source_Values(cmdSection.Value, .Workbooks.Open(s, , True)).Value
'On Error GoTo 0
    End With

    Aggregate Src, Source_Values(cmdSection.Value)
Erase Src
    Exit Sub

EndMe:
End Sub

Private Function Source_Values(ByRef xStr As String, Optional ByRef wkb As Workbook = Nothing) As Range

If wkb Is Nothing Then Set wkb = ThisWorkbook

With wkb
With .Sheets("AAR")
Select Case xStr
Case "S1 Mobilization": Set Source_Values = .[A5:I59]
Case "S1 Administration": Set Source_Values = .[A63:I96]
Case "S1 DEMOB Individuals": Set Source_Values = .[A102:I132]
Case "S1 DEMOB Units": Set Source_Values = .[A137:I181]
Case "CRC": Set Source_Values = .[A185:I234]
Case Else
End Select
End With
End With

Set wkb = Nothing

End Function

Private Sub Aggregate(ByRef Src As Variant, ByRef Rng As Range)

    Dim x   As Long
Dim y As Long
    Dim Trg As Variant: Trg = Rng.Value

    For x = LBound(Src, 1) To UBound(Src, 1)
If Trim$(Trg(x, 1)) = Trim$(Src(x, 1)) Then
For y = LBound(Trg, 2) To UBound(Trg, 2)
If InStr("2|3", CStr(y)) = 0 Then Trg(x, y) = Trg(x, y) + Src(x, y)
Next y
End If
    Next x

    Rng.Value = Trg
Rng.Parent.Activate
    Erase Src: Erase Trg

End Sub
 
Upvote 0
Need to adjust within the Sub Aggregate to only add when x <> 1 so column 1 doesn't summate. Try adjusting the IF line after the match is found.

Away from PC (= next room, wonderful isolation), will post back if I get bored in here and need a change of scenery.

No probs on centring User Form, it’s an OCD type thing for me to ignore!
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,136
Members
448,551
Latest member
Sienna de Souza

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top