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

[chipsworld]

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.

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

 

[JackDanIce]

Replace Private Sub Aggregate with:

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

    Dim x   As Long
    Dim y   As Long
    Dim t   As Variant
    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
            t = Trg(x, 1)
            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
        Trg(x, 1) = t
    Next x

    Rng.Value = Trg
    Rng.Parent.Activate

    Erase Src: Erase Trg: Erase t

End Sub

 

[chipsworld]

Ill get on it first thing when I get to the office...

Just wanted to say thanks for spending the time on this, and stay safe!

I'll let you know!

 

[JackDanIce]

Ill get on it first thing when I get to the office...

Just wanted to say thanks for spending the time on this, and stay safe!

I'll let you know!

Office? Surely you ought to be working from home, although given the file contents.. understandable for emergency reasons!
Best of luck to you as well, to quote a Chinese proverb "We are living in interesting times".

 

[chipsworld]

Jack...
Yes, we are definitely "Essential Personnel" right now. "Things" must move!

OK...this change just made everything in Column A disappear... and did not SUM the columns C:I.

I see what you are trying to accomplish, but to be honest, you are working WAY outside of my skill set in VBA.

What are the "Adjustable" data points in the code? How can I control which columns to take action in?

I assume you still have the file I uploaded, and it contains all of these changes.

Use the source file and test using the CRC section. Some of my data has Alpha characters, which wouldn't be the case in real life. Numeric only. I used Alpha and Numeric to prove to myself that it was copying data over in the original versions. None of this data is real...all just filler numbers for testing.

 

[JackDanIce]

Hi Chip, try with this code, however, I noticed your source file and Master file had CRC section in different cells (A183 vs A185).

Private Sub cmdImport_Click()
    
    Me.Hide
    With Application
        On Error GoTo EndMe
        Aggregate Start_Cell(ActiveSheet, cmdSection.Value), Source_Values(cmdSection.Value, .Workbooks.Open(.GetOpenFilename("*.xls* (*.xls*), *.xls*", , "Select File to Import"), , True))
        On Error GoTo 0
    End With

EndMe:
    Me.Show
End Sub

Private Function Source_Values(ByRef xstr As String, ByRef wkb As Workbook) As Variant
       
    Application.ScreenUpdating = False
    
    ActiveWindow.Visible = False
    ThisWorkbook.Activate
    With wkb
        With .Sheets("AAR")
            Select Case xstr
                Case "S1 Mobilization":  Source_Values = .[A5:I59].Value
                Case "S1 Administration":  Source_Values = .[A63:I96].Value
                Case "S1 DEMOB Individuals":  Source_Values = .[A102:I132].Value
                Case "S1 DEMOB Units":  Source_Values = .[A137:I181].Value
                Case "CRC":  Source_Values = .[A185:I234].Value
                Case Else
            End Select
        End With
        .Close False
    End With
  
    Application.ScreenUpdating = True
  
End Function

Private Function Start_Cell(ByRef wks As Worksheet, ByRef xstr As String) As Range

    Select Case xstr
        Case "S1 Mobilization": Set Start_Cell = wks.[A5:A59]
        Case "S1 Administration": Set Start_Cell = wks.[A63:A96]
        Case "S1 DEMOB Individuals": Set Start_Cell = wks.[A102:A132]
        Case "S1 DEMOB Units": Set Start_Cell = wks.[A137:A181]
        Case "CRC": Set Start_Cell = wks.[A183:A232]
        Case Else
    End Select
        
End Function
Private Sub Aggregate(ByRef rng As Range, ByRef arr As Variant)

    Dim x   As Long
    Dim y   As Long
    Dim v   As Variant
    
    With Application
        .StatusBar = "Updating data..."
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
    
    With rng.Resize(, UBound(arr, 2))
        v = .Value
        For x = LBound(v, 1) To UBound(v, 1)
            For y = 3 To UBound(v, 2)
                v(x, y) = v(x, y) + arr(x, y)
            Next y
        Next x
        .Value = v
    End With
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
            
    On Error GoTo 0
    v = "Finished aggregating data for:   " & rng.Cells(1, 1).Offset(-2).Value & vbCrLf & vbCrLf & "Date Stamp: " & Format([I2].Value, "DDDD DD MMM YYYY")
    MsgBox v, vbOKOnly + vbInformation, "Finished Update Process"
    
    Erase v
    
End Sub

Given how this has been designed, please check every input template maps exactly to the Master file, namely the ranges here (check start and end row for each section on all sheets)

Select Case xstr
                Case "S1 Mobilization":  Source_Values = .[A5:I59].Value
                Case "S1 Administration":  Source_Values = .[A63:I96].Value
                Case "S1 DEMOB Individuals":  Source_Values = .[A102:I132].Value
                Case "S1 DEMOB Units":  Source_Values = .[A137:I181].Value
                Case "CRC":  Source_Values = .[A185:I234].Value
                Case Else
            End Select

 

[chipsworld]

Success!!! I do believe you have done it!

Fixed those range references and all things are good!

I can not begin to thank you enough! Its time for a beer and a nap!

Hope you stay safe and healthy, and that this thing ends very soon! I am tired already of being "Essential"! LOL

 

[JackDanIce]

You're very welcome and whatever you're doing to help is worth a lot lot more than anything I've done here!

Thank you, same to you and let's hope this crisis is over as soon as possible!

Just for avoidance of comments elsewhere, I think with a slight redesign, including use of Excel tables, you could optimise the whole process.

There seems an unnecessary step with the initial dropdown selection and then file selection part, given the structure of both input and Master file are the same, you could just point to a file with the file selector and let the file name contain the section to update.
You can probably drop the UserForm too, may make code easier to debug/adapt for future needs.

If i get time, I'll try to post an alt version to consider. Enjoy the beer and nap too!