VBA Formula Dymanic range

[Hiport]

Hi,

I would like the the SUMIF formula to be dynamic as 291 is not a fixed range

Sub Macro5()
'
' Macro5 Macro
'

'
    ActiveCell.Formula = "=SUMIF($A$5:$A$291,K5,$I$5:$I$291)"
    Range("L5").Select
    Selection.AutoFill Destination:=Range("L5:L114")
    Range("L5:L114").Select
End Sub

 

[ZVI]

If you agree with assumptions in the code comments then try

' Set the fоrmula "=SUMIF(Col_A,Cell_K,Col_I)" into Col_L range
' where:
'   Col_A   - dynamic range, includes A5 and the nonempty cells below
'   Cell_K  - cell in K column at the same (current) row as the (current) cell in Col_A
'   Col_I   - column I at the same rows as Col_A
'   Col_I   - column L at the same rows as Col_A
Sub Test()
  Dim Rng As Range, fm As String
  With ActiveSheet
    If .FilterMode Then .ShowAllData
    Set Rng = .Range("A5", .Cells(.Rows.Count, "A").End(xlUp))
    fm = "=SUMIF(" & Rng.Address & ",K5," & Rng.Columns("I").Address & ")"
    Rng.Columns("L").Formula = fm
  End With
End Sub

 

[Hiport]

Vladimir, i have adapted your code in my code, but i dont think my code is written well, it works but i know it can be written better, could you please have a review and put me in the right direction

Sub AgedDebtor()

    Dim shtRaw               As Excel.Worksheet
    Dim ShtOver2day          As Excel.Worksheet
    Dim ShtTemp              As Excel.Worksheet
    Dim shtTasks             As Excel.Worksheet
    Dim Rng                  As Range
    Dim lDstRowNum           As Long
    Dim Firstrow             As Long
    Dim Lastrow             As Long
    Dim Lrow                As Long
    Dim fm                  As String

 
    Set shtRaw = ThisWorkbook.Sheets("Raw")
    Set ShtOver2day = ThisWorkbook.Sheets("Workings")
  
    'Clear existing data
     ShtOver2day.Range("A6:D" & Rows.Count).Clear
     
        With ShtOver2day
         
            'Add Temp sheet to copy Data
            Set ShtTemp = Sheets.Add
         With ShtTemp

                With shtRaw
                    lDstRowNum = .Range("A" & Rows.Count).End(xlUp).Row
                     .Range("A1:M" & lDstRowNum).Copy ShtTemp.Range("A1")
                     ShtTemp.Cells.EntireColumn.AutoFit
                      ShtTemp.Cells.RemoveSubtotal
                End With
                
                .Columns("A:A").Delete
                .Columns("B:B").Delete
                .Columns("D:F").Delete
            
            Firstrow = .UsedRange.Cells(1).Row
            Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

            'We loop from Lastrow to Firstrow (bottom to top)
            For Lrow = Lastrow To Firstrow Step -1
    
                'We check the values in the A column in this example
                With .Cells(Lrow, "C")
                    If Not IsError(.Value) Then
    
                        If .Value = "Receipt" Then .EntireRow.Delete
                        'This will delete each row with the Value "ron"
                        'in Column A, case sensitive.
    
                    End If
                End With
    
            Next Lrow
             lDstRowNum = .Range("A" & Rows.Count).End(xlUp).Row
            .Range("A5:A" & lDstRowNum).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("K5"), Unique:=True
            .Range("I5:I" & lDstRowNum).FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
          
            
             If .FilterMode Then .ShowAllData
             Set Rng = .Range("A5", .Cells(.Rows.Count, "A").End(xlUp))
                fm = "=SUMIF(" & Rng.Address & ",K5," & Rng.Columns("I").Address & ")"
               Rng.Columns("L").Formula = fm

            
            lDstRowNum = .Range("K" & Rows.Count).End(xlUp).Row
            
            .Range("M5:M" & lDstRowNum).FormulaArray = " =ISNUMBER(MATCH(RC[-2],rngClientCode,0))+0"

            With ShtTemp.UsedRange
             .Copy
             .PasteSpecial xlPasteValues
            End With
        End With
     End With
End Sub

If you agree with assumptions in the code comments then try

' Set the fоrmula "=SUMIF(Col_A,Cell_K,Col_I)" into Col_L range
' where:
'   Col_A   - dynamic range, includes A5 and the nonempty cells below
'   Cell_K  - cell in K column at the same (current) row as the (current) cell in Col_A
'   Col_I   - column I at the same rows as Col_A
'   Col_I   - column L at the same rows as Col_A
Sub Test()
  Dim Rng As Range, fm As String
  With ActiveSheet
    If .FilterMode Then .ShowAllData
    Set Rng = .Range("A5", .Cells(.Rows.Count, "A").End(xlUp))
    fm = "=SUMIF(" & Rng.Address & ",K5," & Rng.Columns("I").Address & ")"
    Rng.Columns("L").Formula = fm
  End With
End Sub

 

[ZVI]

Your code looks pretty good for me

Without knowledge about data layout, range names, the intentions of processing, the below is just modification based on my preferences in fast processing.
Please try it with workbook copy only because it is not tested:

Sub AgedDebtor_01()

  Dim shtRaw As Worksheet
  Dim ShtOver2day As Worksheet
  Dim ShtTemp As Worksheet
  Dim lDstRowNum As Long
  Dim Rng As Range, fm As String, i As Long, r As Long, a, v
  
  Set shtRaw = ThisWorkbook.Sheets("Raw")
  Set ShtOver2day = ThisWorkbook.Sheets("Workings")
  
  ' Turn off events triggering and screen updating
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
  End With
  
  'Clear existing data
  With ShtOver2day
    ' Limit the range to be cleared by UsedRange
    Intersect(.UsedRange, .Range("A6:D" & Rows.Count)).Clear
  End With
  
  'Add Temp sheet to copy Data
  Set ShtTemp = Sheets.Add
  With shtRaw
    If .FilterMode Then .ShowAllData
    lDstRowNum = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A1:M" & lDstRowNum).Copy ShtTemp.Range("A1")
  End With
  
  ' Do main processing
  With ShtTemp
    
    ' Prepare sheet to processing
    With .UsedRange
      .EntireColumn.AutoFit
      .RemoveSubtotal
      ' Copy cells as values to exclude an extra recalculations
      .Copy
      .PasteSpecial xlPasteValues
      .Cells(1.1).Select
      Application.CutCopyMode = False
    End With
    
    ' Delete some columns
    .Range("A:B,D:F").Delete
    
    ' Provide fast deleting of the rows with "Receipt" in C column
    a = Intersect(.UsedRange, .Columns("C")).Value
    For r = 1 To UBound(a)
      v = a(r, 1)
      a(r, 1) = Empty
      If VarType(v) = vbString Then
        If StrComp(v, "Receipt", vbTextCompare) = 0 Then
          i = i + 1
          a(r, 1) = 1
        End If
      End If
    Next
    If i > 0 Then
      With .UsedRange
        .Columns(1).Offset(, .Columns.Count).Value = a
      End With
      With .UsedRange
        .Sort .Cells(1, .Columns.Count), xlAscending, Header:=xlNo
        .Rows(1).Resize(i).Delete
      End With
    End If
    
    ' Do some actions as it were in original code
    lDstRowNum = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("A5:A" & lDstRowNum).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("K5"), Unique:=True
    .Range("I5:I" & lDstRowNum).FormulaR1C1 = "=SUM(RC[-4]:RC[-1])"
    
    ' Put fоrmula "=SUMIF(Col_A,Cell_K,Col_I)" into Col_L range (refer to post #2)
    Set Rng = .Range("A5", .Cells(.Rows.Count, "A").End(xlUp))
    fm = "=SUMIF(" & Rng.Address & ",K5," & Rng.Columns("I").Address & ")"
    Rng.Columns("L").Formula = fm
    
    ' Put an array fоrmula into M column
    fm = "=ISNUMBER(MATCH(RC[-2],rngClientCode,0))+0"
    Rng.Columns("M").FormulaArray = fm
    
    ' Replace entered formulas by values
    With .UsedRange
      .Copy
      .PasteSpecial xlPasteValues
    End With
    
  End With  ' <- ShtTemp
  
  ' Reset events and screen updating
  With Application
    .EnableEvents = True
    .ScreenUpdating = True
  End With

End Sub

Regards,
Vlad