Sum with variable range - excel

I try following VBA Programming, but its formula in excel cell is "=SUM('F12':'F91')" which ' mark can not remove. Can anyone teach me what's problem in my following program?
Sub Step7()
' Step 7 : Insert S code for VBA formula Input
' S - Subtotal
' Prepare formula to each Code
Dim c1, c2 As Long
c1 = 2
For i = 2 To 9999
If Range("H" & i).Value <> "s" Then
c2 = i - 1
ElseIf Range("H" & i).Value = "s" Then
Range("F" & i).Select
ActiveCell.FormulaR1C1 = "=SUM(F" & c1 & ":F" & c2 & ")"
c1 = c2
End If
Next i
End Sub

Related

SumIF values <> "#NV" in the next column

my excelsheets look like this:
Then I tried it with the formula:
=SUMIF(B1:B200;B1:B200<>"#NV";B:B)
But it seems wrong. I want to summarize all numbers if is not #NV in each section (11111, 22222). Each numbers 2,3,4,6,9 belongs to the group 11111. I want to determine the sum of all the values which is allocated to the group 11111.
For 11111: Sums over the cell B2:B6, for 22222, sums over B8:B12. That is what I want to do.
Hope you can help me. If it is possible to have a macro, I would be very thankful, if you can share with your ideas.
Thanks
INDIRECT ft. ARRAY FORMULA
It is highly advised that you replace the occurrences of $B:$B with the actual ranges e.g. $B$1:$B$100
The following two formulas are to be copied to C1 and D1. The second is an array formula and you have to use CTRL+SHIFT+ENTER if you don't have 365.
It's a terrible solution, because the first formula uses indirect which is a volatile (updating after every calculation) function and the second is an array formula. The second should be put in the first instead of D1 but it doesn't work (I'm using Excel 2019). So you have to use an extra column for it. Maybe 365 could accept it.
Hopefully someone will use this information to create a more efficient solution.
The Formulas
These two are the ones you need in C1 and D1:
=IF($B2<>"#NV","",SUM(INDIRECT(ADDRESS(D1,2,4)&":"&ADDRESS(ROW(),2,4))))
=IF($B2<>"#NV","",SMALL(IF($B:$B="#NV",ROW($B:$B)-ROW(INDEX($B:$B,1,1))+2),COUNTIF($B$1:$B1,"#NV")))
This one counts the number of occurrences of "#NV" from B$1 to the current row.
=COUNTIF(B$1:B6,"#NV")
This one is an array formula and returns the row after the first occurrence of "#NV". Note the +2 instead of +1 is for the row below, and the 1 after it represents the first occurrence.
=IFERROR(SMALL(IF($B:$B="#NV",ROW($B:$B)-ROW(INDEX($B:$B,1,1))+2),1),"")
Similarly to the previous, this one is an array formula and returns the row after the last occurrence of "#NV".
=IFERROR(SMALL(IF($B:$B="#NV",ROW($B:$B)-ROW(INDEX($B:$B,1,1))+2),COUNTIF(B$1:B6,"#NV")),"")
This is the SUM/INDIRECT formula: Note the first number 2 is the number to be replaced by the array formula, and the 6 is to be replaced by the last ROW formula.
=SUM(INDIRECT(ADDRESS(2,2,4)&":"&ADDRESS(6,2,4)))
The ROW formula.
=ROW()
Try the next VBA code, please. It creates a range from the error cells of B:B filled column range and exploit the discontinuous range Areas addresses. You did not answer my question regarding the possibility to have two consecutive such errors. Anyhow, the following code is able to deal with such situations, too. If no possible consecutive error rows, the code can be simplified:
Sub testErrorRng()
Dim sh As Worksheet, rngErr As Range, lastRow As Long, Ar As Range
Dim startSum As String, endSum As String, i As Long
Set sh = ActiveSheet
lastRow = sh.Range("B" & rows.count).End(xlUp).row
Set rngErr = sh.Range("B1:B" & lastRow).SpecialCells(xlFormulas)
For Each Ar In rngErr.Areas
i = i + 1
If i = 1 Then
If Ar.cells.count = 1 Then
If Ar.Address = "$B$1" Then
startSum = Ar.Offset(1).Address
Else
Ar.Offset(-1, 1).Formula = "=Sum(B1:" & Ar.Offset(-1).Address & ")"
startSum = Ar.Offset(1).Address
End If
Else
startSum = Ar.cells(Ar.cells.count + 1).Address
End If
Else
If Ar.cells.count = 1 Then
endSum = Ar.Offset(-1).Address
Ar.Offset(-1, 1).Formula = "=Sum(" & startSum & ":" & endSum & ")"
startSum = Ar.Offset(1).Address
Else
endSum = Ar.cells(1).Offset(-1).Address
Ar.cells(1).Offset(-1, 1).Formula = "=Sum(" & startSum & ":" & endSum & ")"
startSum = Ar.cells(Ar.cells.count + 1).Address
End If
End If
Next
If rngErr.Areas(rngErr.Areas.count).row < lastRow Then
endSum = sh.Range("B" & lastRow).Address
sh.Range("C" & lastRow).Formula = "=Sum(" & startSum & ":" & endSum & ")"
End If
End Sub
Please, test it and send some feedback.
Edited:
Shorter version for no consecutive error rows:
Sub testErrorRngSimple()
Dim sh As Worksheet, rngErr As Range, lastRow As Long, Ar As Range
Dim startSum As String, endSum As String, i As Long
Set sh = ActiveSheet
lastRow = sh.Range("B" & rows.count).End(xlUp).row
Set rngErr = sh.Range("B1:B" & lastRow).SpecialCells(xlFormulas)
For Each Ar In rngErr.Areas
i = i + 1
If i = 1 Then
If Ar.Address = "$B$1" Then
startSum = Ar.Offset(1).Address
Else
Ar.Offset(-1, 1).Formula = "=Sum(B1:" & Ar.Offset(-1).Address & ")"
startSum = Ar.Offset(1).Address
End If
Else
endSum = Ar.Offset(-1).Address
Ar.Offset(-1, 1).Formula = "=Sum(" & startSum & ":" & endSum & ")"
startSum = Ar.Offset(1).Address
End If
Next
If rngErr.Areas(rngErr.Areas.count).row < lastRow Then
endSum = sh.Range("B" & lastRow).Address
sh.Range("C" & lastRow).Formula = "=Sum(" & startSum & ":" & endSum & ")"
End If
End Sub

Excel VBA IF OR

Please help to run this formula if the cell C2 value is saturday
Range("F2").Formula = "=IF(AND(D2>=TIME(9,16,0),D2<=TIME(11,59,0)),D2-TIME(9,0,0),IF(AND(D2>=TIME(14,16,0),D2>=TIME(12,00,0)),D2-TIME(14,0,0)*1,0))"
and if Cell C2 value is Sunday to Friday
Range("F2").Formula = "=IF(AND(D2>=TIME(8,16,0),D2<=TIME(10,30,0)),D2-TIME(8,0,0),IF(AND(D2>=TIME(12,16,0),D2>=TIME(10,31,0)),D2-TIME(12,0,0)*1,0))"
Until the last row which has data in the sheet.
In short check the value in C2, if = saturday formula 1 or formula 2.
From C2 onwards Column C contains date. eg
05/03/2019
Sample Excel file Screenshot
Try this:
Option Explicit
Sub Test()
Dim i As Long
For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
If Weekday(Range("C" & i)) = 7 Then
Range("F" & i).Formula = "=IF(AND(D" & i & ">=TIME(9,16,0),D" & i & "<=TIME(11,59,0)),D" & i & "-TIME(9,0,0),IF(AND(D" & i & ">=TIME(14,16,0),D" & i & ">=TIME(12,00,0)),D" & i & "-TIME(14,0,0)*1,0))"
Else
Range("F" & i).Formula = "=IF(AND(D" & i & ">=TIME(8,16,0),D" & i & "<=TIME(10,30,0)),D" & i & "-TIME(8,0,0),IF(AND(D" & i & ">=TIME(12,16,0),D" & i & ">=TIME(10,31,0)),D" & i & "-TIME(12,0,0)*1,0))"
End If
Next i
End Sub

VBA loop, repeat formula through column

I am trying to replicate in VBA the simple function in excel which allows you to repeat a function through an entire column, and stops when the columns on the side are empty. Specifically, I want to repeat an if - else if function for the entire relevant part of the column
Here's an attempt which does not really work
Sub RepeatIfElseif
Range("A1").Select
If selection > 0 Then
Range("B1").Select
ActiveCell.FormulaR1C1 = "X"
Range("A1").Select
ElseIf selection <= 0 Then
Range("B1").Select
ActiveCell.FormulaR1C1 = "Y"
End If
Range("B1").Select
selection.AutoFill Destination:=Range("B1:B134")
Is there any way I can do it with a loop?
You do not need to loop to drop formulas in. You just need to know where the last row is!
Pick a column that is most likely to represent your last row (I am using Column A in my example) and then you can dynamically drop-down your equation in one line without the loop.
The below will fill in the equation A2 + 1 in Column B starting from 2nd row (assuming you have a header row) down to the last used row in Column A
Option Explicit
Sub Formula_Spill()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update sheet!
Dim LR As Long
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row '<-- Update column!
ws.Range("B2:B" & LR).Formula = "=A2+1" '<-- Update formula!
End Sub
If you want to use a loop, you can use something like the code below:
For i = 1 To 134
If Range("A" & i).Value > 0 Then
Range("B" & i).FormulaR1C1 = "X"
Else
Range("B" & i").FormulaR1C1 = "Y"
End If
Next I
It can be done without a loop, something like:
Range("B1:B134").Formula = "=IF(A1>0," & Chr(34) & "X" & Chr(34) & "," & Chr(34) & "Y" & Chr(34) & ")"
Not sure what formula you are trying to achieve with .FormulaR1C1 = "Y" ?
I'm trying to improve my English, I swear...
I would do something like this:
dim row as long
dim last_row as Long
last_row = ActiveSheet.Range("A1048576").End(xlUp).Row
For row = 1 to last_row
If Range("A" & row).Value > 0 Then
ActiveSheet.Range("B" & row).Value = "X"
Else
ActiveSheet.Range("B" & row).Value = "Y"
End If
Next row
Hope this helps.

How to copy data without also copying the row/column width

I am using VBA to copy and paste a variable number of rows from one sheet to another when they meet a criteria.
This is working. However, when the data is pasted into the target sheet the column and row width change to be the same as the source sheet.
How can I stop this from happening? So that just the data is pasted, without the cell formatting.
If anyone knows it would be much appreciated.
Heres the code I'm using.
Sub copyOverdue()
Dim cell As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = ActiveWorkbook.Worksheets("Action Register")
Set Target = ActiveWorkbook.Worksheets("Sheet1")
j = 36 ' Paste to this number row
For Each cell In Source.Range("A7:A243")
If c = "Overdue" Then
Source.Range("A" & c.row & "," & "G" & c.row).Copy Target.Range("AD" & j)
Source.Range("C" & c.row & "," & "F" & c.row & "," & "H" & c.row & "," & "K" & c.row).Copy Target.Range("AF" & j)
j = j + 1
End If
Next cell
End Sub
You can pastespecial values only
For Each cell In Source.Range("A7:A243")
If cell.value = "Overdue" Then
cell.Resize(, 7).Copy
Target.Range("AD" & j).PasteSpecial xlValues
Source.Range("C" & cell.Row & "," & "F" & cell.Row & "," & "H" & cell.Row & "," & "K" & cell.Row).Copy
Target.Range("AF" & j).PasteSpecial xlValues
j = j + 1
End If
Next cell
You can also avoid the clipboard altogether and transfer the values directly, which is more efficient but it can get a bit mess you are dealing with large ranges.
Target.Range("AD" & j).Resize(,7).Value=cell.Resize(, 7).value

Using variables to reference columns and range in R1C1 formula

I am trying to use variable in Vlookup formula in R1C1 form. I am not able to get the syntax right for table array.
I tried this:
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[" & -39 - a & "],'Tmp-UPCR'!C1:C&a+1,&a+1,0)" 'Check the formula
The code I am using this in is:
Dim a As Integer
For a = 1 To i
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[" & -39 - a & "],'Tmp-UPCR'!C1:C&a+1,&a+1,0)" 'Check the formula
ActiveCell.Offset(0, 1).Select
Next a
How could I get this formula working?
Replace your formula with:
"=VLOOKUP(RC[" & -39 - a & "],'Tmp-UPCR'!C1:C" & a + 1 & "," & a + 1 & ",0)"
However, you can avoid all this Select and ActiveCell and use directly the For loop below:
For a = 1 To i
' modify Column A below to the column where you want to put your formula
Range("A" & i).FormulaR1C1 = "=VLOOKUP(RC[" & -39 - a & "],'Tmp-UPCR'!C1:C" & a + 1 & "," & a + 1 & ",0)" 'Check the formula
Next a

Resources