VBA Help - Loop to Select Range and Apply to a working Macro - Excel 2016

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
693
Office Version
  1. 2016
Platform
  1. MacOS
Hello All,

I am working on automating a Journal Entry Tool and could use some help with the last part of my tool.

In need of code that will loop thru a range of cells and find a matching value to the Business Unit and log the cell.address in a sum formula.

Full Description:

1. Column A is my Business Unit
2. Column B is my Offset to column A, so if column B contains the text "Offset" this is a row that will need this Dynamic Offsetting Sum formula
3. Column C is my Amount Column

Sample Data
Sheet1

ABC
Apple
Banana
Pear
AppleOffset (Here is sample answer
PearOffset
BananaOffset
Apple

<tbody>
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]1[/TD]
[TD="align: center"]Business Unit (Drop Down)[/TD]
[TD="align: center"]Offset Entry (Select if line is an offset entry)[/TD]
[TD="align: center"]Amt[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]2[/TD]

[TD="align: right"]100[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]3[/TD]

[TD="align: right"]200[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]4[/TD]

[TD="align: right"]300[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]5[/TD]

[TD="align: right"]-250[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]6[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]7[/TD]

[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=cacaca]#cacaca[/URL] , align: center"]8[/TD]

[TD="align: right"]150[/TD]

</tbody>

Spreadsheet Formulas
CellFormula
C5=-SUM(C2,C8)

<tbody>
</tbody>

<tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4

My Working Code to create the Sum Formula - This works with the User manually selecting which cells are matches


Code:
Sub Concatenate_Formula()

Dim rSelected   As Range, rOutput As Range, c As Range
Dim sArgs       As String, sArgSep As String, sSeparator As String, sTitle As String
Dim bCol        As Boolean, bRow As Boolean
Dim vbAnswer    As VbMsgBoxResult
Dim lTrim       As Long

'Set variables
Set rOutput = ActiveCell
bCol = False
bRow = False
sSeparator = ""
sTitle = "CONCATENATE"

    'Prompt user to select cells for formula
    On Error Resume Next
    Set rSelected = Application.InputBox(Prompt:= _
                    "Select cells to create formula", _
                    Title:=sTitle & " Creator", Type:=8)
    On Error GoTo 0
    
    'Only run if cells were selected and cancel button was not pressed
    If Not rSelected Is Nothing Then
        
        'Set argument separator for concatenate or ampersand formula
        sArgSep = ","
      
        'Create string of cell references
        For Each c In rSelected.Cells
            sArgs = sArgs & c.Address(bRow, bCol) & sArgSep
            If sSeparator <> "" Then
                sArgs = sArgs & Chr(34) & sSeparator & Chr(34) & sArgSep
            End If
        Next
        
        'Trim extra argument separator at the end of formula
        lTrim = IIf(sSeparator <> "", 4 + Len(sSeparator), 1)
        sArgs = Left(sArgs, Len(sArgs) - lTrim)


        rOutput.Formula = "=-Sum(" & sArgs & ")"
        
    End If


End Sub
 
Last edited:

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
In the example of B5, you want the macro to sum all the values in Column C that match "Apple"? You want this to be a formula?
Can the formula be:
=-SUMIFS($C2:$C1000,$A2:$A1000,A5)
Or are you trying to just sum the values up to that point? In which case it could be: =-SUMIFS($C2:$C5,$A2:$A5,A5)

This is my first stab at the code. It seems to me that you might need more. Tell me if I'm wrong, the Offset value to that point should only sum the values that haven't been OFFSET before. We may need to create another column to help track if the values have been offset previously. Or have the macro look for the last offset value for that Business unit and only SUMIFS from that point down.

Code:
Sub AddOffsetFormula()
  Dim R As Range
  Dim Cel As Range
  Dim BegRow As Long        'First row of data
  Dim OSCol As Long         'Offset column
  Dim BUCol As Long         'Business unit column
  Dim AmtCol As Long        'Amount Column
  Dim A As String
  Dim BUAddr As String      'Address of BU range down to the cell
  Dim AmtAddr As String     'Address of Amt range down to the cell
  Dim BUCritAddr As String  'Address of Name of Current BU
  
  BegRow = 2
  OSCol = 2
  BUCol = 1
  AmtCol = 3
  
  
  Set Cel = Cells(BegRow, OSCol)
  Set R = Range(Cel, Cells(Cells.Rows.Count, OSCol).End(xlUp))
  
  For Each Cel In R
    A = UCase(Cel.Value)
    If InStr(A, "OFFSET") > 0 Then
      BUAddr = Range(Cells(BegRow, BUCol), Cells(Cel.Row, BUCol)).Address
      AmtAddr = Range(Cells(BegRow, AmtCol), Cells(Cel.Row, AmtCol)).Address
      BUCritAddr = Cells(Cel.Row, BUCol).Address
      Cel.Formula = "=SUMIFS(" & AmtAddr & "," & BUAddr & "," & BUCritAddr & ")"
    End If
  Next Cel
  
End Sub
 
Upvote 0
To answer your question, yes I need the code to build the sum formula like =-"Sum(A2,A8)" For the Apple scenario.

I got to the same point of your code here with a different route but unfortunately its not going to work.

Your code doesn't capture the last row (8) with the Business Unit "Apple".

The problem really comes from having two offset lines on top of each other because then the range style formulas like what your code is doing cause a circular reference.

----
I've researched and modified the below code to solve the issue of incrementally building the SUM formula but I am having the hardest time finding out where to insert my SUM Formula with the below code.

Currently, on the first pass the code returns "$A$2,$A$8" but as it continues to loop and pick up the next Offset (Business Unit) it continues to append to the "$A$2,$A$8" instead of clearing the old StrResults and giving a new string for the new Offset (Business Unit).

If I am not being clear let me know and I can elaborate further

Code:
Sub CreateDynamicSum()


Dim strResults As String, StrSearch As String
Dim Sht As Worksheet
Dim sFirstAddress
Dim DataSet As Range, Cell As Range, rFND As Range, FoundData As Range
Dim LastR As Long, ltrim As Long


Set Sht = Sheets("Input")
LastR = Sheets("Input").Cells(Rows.Count, "B").End(xlUp).Row  '2 refers to the row to start on
Set DataSet = Sht.Range("E12:E" & LastR & "")
Set FoundData = Range("D12:D" & LastR & "")
   
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    
    For Each Cell In DataSet
        If Cell.Value = "Offset" Then
            Cell.Select
                StrSearch = Cell.Offset(0, -1).Value
                MsgBox StrSearch
    
    'Searches for String Variable "StrSearch"
    Set rFND = FoundData.Find(What:=StrSearch, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not rFND Is Nothing Then
          sFirstAddress = rFND.Address
            Do
                If strResults = vbNullString Then
                    strResults = rFND.Address & "," 'Find the first occurance of the Search String
                Else
                    strResults = strResults & rFND.Address & "," 'Builds on the search string
                End If
                Set rFND = FoundData.FindNext(rFND)
                Loop While Not rFND Is Nothing And rFND.Address <> sFirstAddress
        
           End If
        End If

'Trim extra argument separator at the end of formula
ltrim = IIf("" <> "", 4 + Len(""), 1)
strResults = Left(strResults, Len(strResults) - ltrim)

'Somewhere in here I would enter my Sum formula Cell.Offset(0,7).Formula = "Sum(" & StrResults & ")"
               
         Next 'Moves to the next Cell

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,275
Messages
6,171,119
Members
452,381
Latest member
Nova88

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