I am new to VBA and am trying to create a report template for work. I also want to see how this would be coded for my own personal understanding instead of using a formula.
Put simply I have a variable set of values in column A and dates in column B. Column D is a variable range of dates (user input. I would like to have this as an array within my code.)
I would like to sum column A while excluding the dates specified in column D, and have this sum output into cell G1. I have attached a picture below.
Thanks in advance!
Picture of the sheet
Try out this code, this is self explanatory.
Sub sumVariables()
Dim i As Long, j As Long, sum As Long, match As Boolean
sum = 0
match = False
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To Cells(Rows.Count, 4).End(xlUp).Row
If Cells(i, 2) = Cells(j, 4) Then
match = True
End If
Next j
If match = False Then
sum = sum + Cells(i, 1)
End If
match = False
Next i
Cells(1, 7) = sum
End Sub
This code would work for n number of rows in your sheet and give the total in G1. Let me know if you need any help.
Related
I´m new in VBA Excel. I´m trying to make a macro which is not difficult, but I´m so inexperienced.
I have sheet1 with column of dates (whole month), for each date there is different value. So column A is full of dates and column B is full of values (in relation with date). Sheet2/column A is also created by dates (whole month).
I would like to create a macro, which copy the value from sheet1/column B and pass it to sheet2/column B according to date. In other words, the macro should find certain date (in sheet2/column A) and pass specific value to sheet2/column B.
Try this, you might need to change some values to match you workbook.
Like the sheets name and starting row on the for loop.
Sub sheetValues()
'collect information in sheet one into an array
With Sheets("Sheet1")
'check last filled in cell in column / last date
Set last = .Range("A:A").Find("*", .Cells(1, 1), searchdirection:=xlPrevious)
'new array with range information
sheetOneInfo = .Range(.Cells(1, 1), .Cells(last.Row, 2)).Value
End With
With Sheets("Sheet2")
'check last filled in cell in column / last date
Set last = .Range("A:A").Find("*", .Cells(1, 1), searchdirection:=xlPrevious)
'for each cell in range
For n = 1 To last.Row
'if value in sheet two is in array
If InArray(.Cells(n, 1).Value, sheetOneInfo) > 0 Then
'put collected value in appropriate cell
.Cells(n, 2).Value = sheetOneInfo(InArray(.Cells(n, 1).Value, sheetOneInfo), 2)
End If
Next
End With
End Sub
Function InArray(val As String, arr As Variant) As Double
InArray = 0
'for each value in array
For n = 1 To UBound(arr)
'if date in array matches cell date
If arr(n, 1) = val Then
'return date position
InArray = n
Exit Function
End If
Next
End Function
You can try something like this code below. You can change numbers 100 depending how many data you have or if it changes you can calculate it.
For i = 1 To 100
For j = 1 To 100
If Sheets(2).Cells(j, 1) = Sheets(1).Cells(i, 1) Then
Sheets(2).Cells(j, 2) = Sheets(1).Cells(i, 2)
End If
Next j
Next i
I want to calculate the average of the cells in column E, only for the rows that have 0 in column I. It needs an if condition and then perform the standard average line of code.. I am providing the code I have written to calculate the average for all cells in column E. This code needs editing to include this if condtion. If someone knows what to add to have this if condition I would appreciate it !
Also, I am providing a screenshot
lastrow = Cells(Rows.Count, "D").End(xlUp).Row
Range("C1").Formula = "=AVERAGE(E2:E" & lastrow & ")"
formula:
=AVERAGEIF(I:I,0,E:E)
or in vba:
WorksheetFunction.AverageIf(Range("I:I"), 0, Range("E:E"))
As far as I know you cannot do this with an excel function unless you make it an array function. Array functions are powerful but can be very slow at calculating. Here is a VBA solution using a VBA collection.
The answer you selected is definitely a more efficient way of getting the answer. But this code may be useful if you are wanting to manipulate those numbers in other ways since it puts them into a collection.
I made a VBA collection and added to it all values in E that corresponded to 0 values in D. Then I summed it into a variable called f and then divided it by the count of the collection. Then dropped it in the range you wanted.
Sub test()
Dim a As Collection
Dim lastrow As Integer
Set a = New Collection
lastrow = Cells(Rows.Count, "D").End(xlUp).Row
For x = 1 To lastrow
If Cells(x, 9) = 0 Then
y = Cells(x, 5).Value
a.Add (y)
End If
Next x
For Z = 1 To a.Count
f = a.Item(Z) + f
Next Z
Range("C1").Value = (f / a.Count)
End Sub
I have a table with time values. If any value exists in a specified row that is greater than 90 minutes (1:30:00), I need to add the difference (i.e. how much greater it is) to a running total at the end of the row. So, that box could be blank, could have just one cell's value, or could have multiple values added. I already have the For loop to go through each cell in a row. I need the part to sum the values. And ideally, if there was a nested loop to do 6 separate sums for the 6 rows...
'Add break munutes
fp.Activate
Dim rng As Range
For Each rng In Range("B3:F3")
If rng.Value > TimeValue("1:31:00") Then
End If
Next rng
If you want to avoid VBA, this can actually be done by an Excel formula:
=SUMIF($B$3:$B$9,">"&1.5/24)-COUNTIF($B$3:$B$9,">"&1.5/24)*1.5/24
That sums up all values that exceed 90 minutes, and then subtracts off 90 minutes from the total for each value that has been counted.
I would recommend Excel Formula if that is an option, because of the restrictions of VBA solutions.
=SUMPRODUCT((B$3:B9-1/16)*(B$3:B9>1/16))
or a bit shorter with array formula (enter with Ctrl + Shift + Enter) :
=SUMIF(B$3:B9-1/16,">0")
Hard to say if this is fully accurate without more information, but something like this should work for you:
Sub tgr()
Dim aTimes As Variant
Dim dTime As Double
Dim aSumResults() As Double
Dim lResultIndex As Long
Dim i As Long, j As Long
Dim bFirst As Boolean
dTime = TimeValue("01:00:00")
aTimes = ActiveSheet.Range("B3:F9").Value 'Change to the full table range
ReDim aSumResults(1 To UBound(aTimes, 1) - LBound(aTimes, 1) + 1, 1 To 1)
For i = LBound(aTimes, 1) To UBound(aTimes, 1)
'Each i represents a row of the data
'Go through each column and collect the conditional sums
lResultIndex = lResultIndex + 1
bFirst = True 'Use bFirst to ignore first value greater than dTime
For j = LBound(aTimes, 2) To UBound(aTimes, 2)
If aTimes(i, j) > dTime Then
If bFirst Then
'This if the first value found for the row, ignore it
bFirst = False
Else
'Not the first value found, include in sum
aSumResults(lResultIndex, 1) = aSumResults(lResultIndex, 1) + aTimes(i, j) - dTime
End If
End If
Next j
Next i
'Output the results
ActiveSheet.Range("G3").Resize(UBound(aSumResults, 1)).Value = aSumResults
End Sub
You said you wanted the sum of the times in a row but then defined B3:B9, so I assumed you meant the sum of the times in a column.
Try this:
Dim i As Integer
Dim num1 As Date
For i = 3 To 9
If Cells(i, 2).Value > TimeValue("1:30:00") Then
num1 = Cells(10, 2).Value + Cells(i, 2).Value - TimeValue("1:30:00")
Cells(10, 2).Value = num1
End If
Next i
I've defined where the sum is put as cell B10. You could make a similar loop for each column. I tried this out and it worked for me.
I am trying to create a predictive algorithm in VBA that would search for strings in a particular row from a data source, and return a value based on the row number. This is the first step in the workflow, and in its simplest form, there are 2 tables as shown below:
Source Table:
Output Table:
This is what I'm trying to do:
Pick up the strings in Row 1 of Output Table (Blue,Black) and search for them in Rows 1,2,3,4 of Source Table.
If both strings match in a single row, the 'Input' cell from that particular row is copied to Row 1 in Output Table in the 'Output' column.
Example (2nd iteration):
From Output Table Row 2, strings Ivory,Green,Grey are picked up and queried in all rows of Source Table. If any 2 out of 3 strings match in a single row on Source Table, the Input cell of that row is copied.
In this case, Ivory and Green match in Row 1, and also in Row 4. Either input cell would work, but for the sake of having a rule, lets take the last match (Row 4). So '1,8' would be copied to Row 2 on Output Table.
This the flow I am currently using, but I'm getting an incorrect output:
For i = 2 To 5
For j = 1 To 4
For k = 2 To 5
For l = 1 To 5
If Cells(i, j).Value = Worksheets("SourceTable").Cells(k, l).Value And Cells(i,j).Value <> "" Then
For a = 1 To 5
For b = 1 To 4
If Cells(i, b).Value = Worksheets("SourceTable").Cells(k, a).Value And Cells(i, b).Value <> "" Then
Cells(i, 15).Value = Worksheets("SourceTable").Cells(k, 5).Value
GoTo iLoop
End If
Next b
Next a
End If
Next l
Next k
Next j
iLoop:
Next i
Both tables would have around half a million rows, and I am trying to figure out how to reduce the number of loops and make it work at the same time. Any suggestions would be appreciated, this would help me save a lot of man-hours and automate a major chunk of the process. Thanks!
Sub macro()
lastRowOut = Sheets("OutputTable").Range("A" & Rows.Count).End(xlUp).Row
lastRowSou = Sheets("SourceTable").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To lastRowOut
For j = 2 To lastRowSou
If checkRow(j, i) >= 2 Then
Sheets("OutputTable").Cells(i, 5) = Sheets("SourceTable").Cells(j, 6)
Exit For
End If
Next j
Next i
End Sub
Function checkRow(sRow, i)
lastCol = Split(Sheets("OutputTable").Cells(i, Columns.Count).End(xlToLeft).Address, "$")(1)
counter = 0
For Each cell In Sheets("OutputTable").Range("A" & i & ":" & lastCol & i)
If Not Sheets("SourceTable").Range("A" & sRow & ":" & "E" & sRow).Find(cell.Value) Is Nothing Then
counter = counter + 1
End If
Next cell
checkRow = counter
End Function
Quite a few things are unclear so here were the assumptions I made:
Two or more of the cells in a row in the OutputTable have to be matched for the prediction to be made.
The first rows of both the Output and Source sheet contain "Col1, Col2" etc.
You seem to not mind whether we use the first or last matching row (from the source sheet) so I went with the first.
That's 3 loops instead of 6..
you can try this
Option Explicit
Sub main()
Dim row As Range
With Worksheets("OutputTable")
For Each row In .Range("D2", .Cells(.Rows.count, 1).End(xlUp)).Rows '<--| change "D" to "OutputTable" sheet last "col" column index (i.e. the one before "Output" column)
SearchSource row
Next
End With
End Sub
Sub SearchSource(rng As Range)
Dim cell As Range, row As Range
Dim nFounds As Long
With Worksheets("SourceTable")
For Each row In .Range("E2", .Cells(.Rows.count, 1).End(xlUp)).Rows '<--| change "E" to "SourceTable" sheet last "col" column index (i.e. the one before "Input" column)
nFounds = 0
For Each cell In rng.SpecialCells(xlCellTypeConstants)
If Not row.Find(what:=cell.Value, lookat:=xlWhole, LookIn:=xlValues) Is Nothing Then nFounds = nFounds + 1
If nFounds = 2 Then Exit For
Next
If nFounds = 2 Then rng.Cells(, rng.Columns.count + 1).Value = row.Cells(, row.Columns.count + 1).Value
Next
End With
End Sub
'Try this:
'First declare some variables:
'the number of rows of the Output table
Dim OrNum as integer
'the number of columns of the Output table
Dim OcNum as integer
'the number of rows of the Source table
Dim SrNum as integer
'the number of columns of the Source table
Dim ScNum as integer
'some dummy variables for the loops
Dim rO as integer, cO as integer
Dim rS as integer, cS as integer
And then declare a boolean variable (just for later on)
Dim bool as boolean
'Then assume the output table has it's first cell at the most 'top and the most left of the output table, which is taken to 'be the cell Z1 in the following Code
'Begin with this first cell of the Output table and get each 'value in a way, that you move first (inner loop) over the 'columns by fixing the row Index (rO) of the Output table and then (outer loop) get down to each and every row like this:
For rO = 0 to OrNum - 1
For cO = 0 to OcNum - 1
Range("Z1").Offset(rO, cO)
Next
Next
'Now you don't have only strings so you will need to check, 'if the value in the cell is a string or a number. There is VBA 'function, that can help. It's called IsNumeric. It will give 'True if the value is a numeric value. If we have a string, then it will give False. With the Function IsEmpty() you can also check if a cell is empty or not. If a cell is empty, then the function IsEmpty will return True.
For rO = 0 to OrNum - 1
For cO = 0 to OcNum - 1
bool = IsNumeric(Range("Z1").Offset(rO, cO).Value)
bool = bool Or IsEmpty (Range("Z1").Offset(rO, cO).Value)
If bool=False then
'we have a string!
'do something
End if
Next
Next
Alright for this project I am trying to take columns headers and combine them in row headers in one column. For instance
There a column header plant store it has rows with corresponding data tr1, tr2, tr3.
I want to make one full column with the data so it appears like this "plant store tr1", "Plant store tr2" etc...
this is the code I have so far.
J represents an arbitrary range that I want all the data to fill
X represents the location of all the tr1, tr2s, I want added to the end of plant store
plant store is located at J15 in detailed ratings.
Sub Double_column_method()
Dim J As Variant
Dim x As Variant
Set J = Range("A6:A400")
Sheets("Sheet2").Select
Range("A6").Select
For x = Sheets("Detailed Ratings").Range("J15") To Sheets("Detailed Ratings").Range("BQ15")
If J.Value <> "" Then J.Value = x&(Sheets("Detailed Ratings")).Range("I16")
Next
End Sub
Thank you any help is appreciated.
If I'm reading your post correctly, I think the following is what you need. It can be done without VBA. Type the formula in yellow and copy down/across.
Sub test()
Row = Cells(Rows.Count, "A").End(xlUp).Row
r = Row - 15
Column = Cells(16, Columns.Count).End(xlToLeft).Column
c = Column - 9
For i = 1 To r
For J = 1 To c
n = n + 1
Cells(n, "BU") = Cells(i + 15, "I") & Cells(15, J + 9)
Next J
Next i
This solved it for me, produced a clean list of all my headings combined.