How to use Countifs formula in VBA? - excel

I am working on a workbook where there are 8 worksheets.
Names of worksheets:
[Hierarchy, wins, outlook, pcv, misses, losses, backdate, login].
In "Hierarchy" worksheet I want to apply the formula in a column B, up to the last value of that column B (which includes names of sales person). (I guess we will use a loop, I'm not sure which loop should I use.)
=COUNTIFS(wins!$AL:$AL,Hierarchy!$B4,wins!$P:$P,"Complete")
PS: I need help in above countif formula and loop (in VBA) to use that formula up to the last record in the column.

If you just need a result as opposed to filling formulas down the column in a worksheet, you could use one of these options:
Fast one - only using loops:
Sub countifs_in_vba()
Dim Result As Long
Dim i As Long
Dim cell As Range
Dim wsHierarchy As Worksheet
Dim wsWins As Worksheet
Set wsHierarchy = ThisWorkbook.Sheets("Hierarchy")
Set wsWins = ThisWorkbook.Sheets("wins")
For Each cell In Intersect(wsHierarchy.Range("B:B"), wsHierarchy.UsedRange)
For i = 1 To wsWins.Cells.SpecialCells(xlCellTypeLastCell).Row
If cell.Value = wsWins.Cells(i, "AL").Value And wsWins.Cells(i, "P").Value = "Complete" Then
Result = Result + 1
End If
Next
Next
MsgBox Result
End Sub
Slower one - employing Application.WorksheetFunction:
Sub countifs_in_vba2()
Dim Result As Long
Dim cell As Range
Dim wsHierarchy As Worksheet
Dim wsWins As Worksheet
Set wsHierarchy = ThisWorkbook.Sheets("Hierarchy")
Set wsWins = ThisWorkbook.Sheets("wins")
For Each cell In Intersect(wsHierarchy.Range("B:B"), wsHierarchy.UsedRange)
Result = Result + Application.WorksheetFunction.CountIfs(wsWins.Range("AL:AL"), cell.Value, wsWins.Range("P:P"), "Complete")
Next
MsgBox Result
End Sub

Related

Update all links at once

I have a Workbook with many sheets almost all of them have a hyperlink to cell A1 in one specific sheet named 'HK 2017'. I want to change the name of the hyperlinked sheet from 'HK 2017' to 'HK'. And also update all links at once, so that they could work with the new name of the sheet.
Thanks for help.
Loop through the sheets in the worksheet. Excel VBA looping through multiple worksheets
In every sheet, loop through the cells in the used range. Excel VBA iterate over all used cells and substitute their values
Change their hyperlink values. changing a wildcard in an excel hyperlink with vba or Excel VBA Get hyperlink address of specific cell
Party like it's your birthday - https://www.youtube.com/watch?v=5qm8PH4xAss
Here is my solution. In all worksheets of the current workbook I simply replace a given string in the formula for a different one
Public Sub edit_links()
Dim iSheet As Worksheet
Dim old_text as string
Dim new_text as string
old_text = "='\\C\client\XYZ\[old_excel_file.xlsm]Sheet1'"
new_text = "=Sheet1"
For Each iSheet In ThisWorkbook.Sheets
'Debug.Print isheet.Name
Call update_all_cell_formulas_in_sheet( _
isheet, _
old_text, _
new_text)
Next iSheet
End Sub
private Sub update_all_cell_formulas_in_sheet(in_sheet As Worksheet, in_search As String, in_replace As String)
Dim counter As Integer
Dim iCell As Range
counter = 0
For Each iCell In in_sheet.UsedRange
If InStr(iCell.Formula, in_search) > 0 Then
counter = counter + 1
'Debug.Print iCell.Parent.Name, iCell.Address, iCell.Formula
iCell.Formula = Replace(iCell.Formula, in_search, in_replace)
'Debug.Assert counter Mod 100 <> 0 ' stop the code every 100 changes
End If
Next iCell
update_all_cell_formulas_in_sheet = counter
End Sub

Working with the Columns function - Excel VBA

I have been looking around the site for a while for an answer to this question but no luck just yet. I have this code where I loop through a row of numbers and depending on what number is in the cell at the time, determines what I copy and paste to the sheet. I am using Columns for this because it is the only way I can make my code dynamic. It works but when I paste I would like to paste in cells lower than where it's pasting right now. I was wondering if Columns had a way of specifying what column and where to paste my data.
Code:
Dim sh As Worksheet
Dim rw As Range
Dim row As Range
Dim cell As Range
Dim RowCount As Integer
Set rw = Range("A5:CG5")
Set sh = ActiveSheet
For Each row In rw.Rows
For Each cell In row.Cells
Select Case cell.Value
Case "2"
ThisWorkbook.Worksheets("Sheet1").Range("E27:E51").Copy Destination:=Sheets("Sheet2").Columns(4)
End Select
Next cell
Next row
Your problem can be solved as Jeeped said, use Destination:=Sheets("Sheet2").Cells(27, 5) or Destination:=Worksheets(2).Range("E27")
Since you want to learn a little bit more, i made an example explanation:
https://msdn.microsoft.com/en-us/vba/excel-vba/articles/range-column-property-excel
On the link it is explained that .Column:
Column A returns 1, column B returns 2, and so on.
And the same is with the .Rows
Use .Cells https://msdn.microsoft.com/pt-br/library/office/ff194567.aspx So you can use the .Cells(Rows,Columns) or .Cells(Index from a Range) or the entire Object:
With Worksheets("Sheet1").Cells.Font
.Name = "Arial"
.Size = 8
End With
So an example if you want to turn your spreadsheet dynamical: to copy from range $E$27 to last row with something written from column $E on Sheet1 To
the last column with nothing written on row 1 on Sheet2.
Sub test()
'Declare variables here
Dim sht1, sht2 As Worksheet
'sht1 has the data and sht2 is the output Worksheet, you can change the names
last_row = Worksheets(1).Range("E65536").End(xlUp).Row
last_column = Worksheets(2).Cells(1, sht1.Columns.Count).End(xlToLeft).Column
'Data add
For i = 27 To last_row
'Start from Row 27
Worksheets(2).Cells(i - 26, last_column + 1) = Worksheets(1).Cells(i, 5)
Next i
MsgBox "Data Updated"
End Sub
And an example of a basic dynamical workbook with i=i+1 and For loops split a single row of data into multiple unique rows into a new sheet to include headers as values and cell contents as values

Visual Basic 2007 Adding values

To start with I'm not really a wise man. So I was trying to add up two values and display them in a third (that's easy) but I also wanted it to repeat an infinite amount of times (namely that it does the same for every row, let's say I place the result in I5, I want also, on every I under it (I6, I7, I8, etc...)
Should it be:
Private Sub Worksheet_Change()
if IsNumeric(Range("B1").sort) And IsNumeric(Range("B2").sort) then
Dim value1 As Single
Dim value2 As Single
range(I5).sort = value+1 + value2
End Sub
Or as I think I'm horribly mistaken?
You're using the .Sort property of Range where you should be using .Value.
There's a couple of ways to achieve what you're looking to do. First option is to iterate through the range and add the relevant value to each cell like so:
Public Sub addCells()
Dim rng As Range, cell As Range
'Set the sheet name
With ThisWorkbook.Worksheets("Sheet_Name")
'Set the range below:
Set rng = .Range("I1:I10")
'Loop through range and add cells together
For Each cell In rng
cell.Value = cell.Offset(0, 2) + cell.Offset(0, 1)
Next cell
End Sub
Another way to do it if the values to be added is ordered in for example column A and B would be:
Public Sub addCells()
Dim rng As Range, cell As Range
'Set the sheet name
With ThisWorkbook.Worksheets("Sheet1")
'Add the first formula to the sheet
.Range("C1").Value = "=SUM(A1+B1)"
'Change the range below to the range to be filled
.Range("C1").AutoFill Destination:=.Range("C1:C10")
End With
End Sub

How to ignore filtered-out data in Excel formula

I am using an Index/Match to get data from a related table to populate in the first table. In my related table I have filtered out values, but the filtered out values are still populating in my first table. If Index/Match is not smart enough to only grab the filtered values, how can I work around this (formula preferred, but VBA acceptable) to get only the filtered values.
Here is my current formula:
=INDEX(Table_owssvr__1[MyValues],MATCH([#[ID]],Table_owssvr__1[ID],0))
You might find the SUBTOTAL function useful, as it only works on visible rows. (Here's some more general discussion about SUBTOTAL)
But if that's not flexible enough for your needs, here's how to check whether a certain cell is filtered out or not.
Using this, I've written a bit of VBA code to sum over a column summing only visible cells. Should be a pretty useful start in doing whatever you need to do.
If summing over the cells is not what you want to do, just change the part indicated in the comments. (Obviously you'd have to change the name of the function from sumFilteredColumn to something else!)
Public Function sumFilteredColumn(startCell As Range)
Dim lastRow As Long ' the last row of the worksheet which startCell is on
Dim currentCell As Range
Dim runningTotal As Long ' keeps track of the sum so far
lastRow = lastRowOnSheet(startCell)
Set currentCell = startCell
' Loop until the last row of the worksheet
Do While currentCell.Row <= lastRow
' Check currentCell is not hidden
If Not cellIsOnHiddenRow(currentCell) Then
' -------------------------------------------------
' Here's where the magic happens. Change this to
' change sum to, e.g. concatenate or multiply etc.
If IsNumeric(currentCell.Value) Then
runningTotal = runningTotal + currentCell.Value
End If
' -------------------------------------------------
End If
Set currentCell = currentCell.Offset(1) ' Move current cell down
Loop
sumFilteredColumn = runningTotal
End Function
' return the number of the last row in the UsedRange
' of the sheet referenceRange appears in
Public Function lastRowOnSheet(referenceRange As Range) As Long
Dim referenceSheet As Worksheet
Dim referenceUsedRange As Range
Dim usedRangeCellCount As Long
Dim lastCell As Range
Set referenceSheet = referenceRange.Parent
Set referenceUsedRange = referenceSheet.usedRange
usedRangeCellCount = referenceUsedRange.Cells.CountLarge
Set lastCell = referenceUsedRange(usedRangeCellCount)
lastRowOnSheet = lastCell.Row
End Function
' Is the row which referenceCell is on hidden by a filter?
Public Function cellIsOnHiddenRow(referenceCell As Range) As Boolean
Dim referenceSheet As Worksheet
Dim rowNumber As Long
Set referenceSheet = referenceCell.Parent
rowNumber = referenceCell.Row
cellIsOnHiddenRow = referenceSheet.Rows(rowNumber).EntireRow.Hidden
End Function
LondonRob mentioned the SUBTOTAL function. AGGREGATE is a more general function than SUBTOTAL that operates with knowledge of both hidden and filtered cells (there is a difference). They'll do that without addins or VBA, though with somewhat hard-to-read formulae.
I learnt it from here.
I have been able to get this working by the following:
1) Create three worksheets, one for clients, one for purchases, and one for purchasesforclient.
2) Create a Macro to copy filtered values to a new worksheet:
Sub Purchases()
Dim Rng As Range
Set Rng = Worksheets("Comments").Columns("A")
Set Rng = Rng.Resize(65535, 1).Offset(1, 0)
Set Rng = Rng.Resize(, 5).SpecialCells(xlCellTypeVisible)
Rng.Copy Worksheets("PurchasesforClient").Range("A2")
End Sub
3) When I update the purchases via a filter, I run the macro in step 2 by creating a subtotal field and triggering the macro as follows. Since it is a formula, it requires a calculation to occur. This is embedded in the purchases sheet as VBA where the filtering is occurring, where B23 is the subtotal field that changes when it counts the amount of items once a filter is applied:
Public CurrentValue As Double
Private Sub Worksheet_Activate()
CurrentValue = Application.WorksheetFunction.Sum(ActiveSheet.Range("B23"))
End Sub
Private Sub Worksheet_Calculate()
If Application.WorksheetFunction.Sum(Range("B23")) <> CurrentValue Then Purchases
End Sub
4) I use the now filtered values in the purchasesforclient worksheet for my index/match formula in the clients worksheet. This allows me to dynamically filter by date, purchase type, etc. and have updated information in the clients worksheet
This answer requires MOREFUNC addon*
=INDEX(ARRAY.FILTER(Table_owssvr__1[MyValues]),MATCH([#[ID]],ARRAY.FILTER(Table_owssvr__1[ID]),0))
ARRAY.FILTER() function "Stores only the visible cells of a range (for instance a filtered range) in an array and returns this array. "
*MOREFUNC ADDON
Morefunc Addon is a free library of 66 new worksheet functions.
HERE is some information (by original author)
here is the last working download link I found
here is a good installation walk-through video

Write to two cells at same time excel vba

I need to write the same data into two different range of cells for a VBA application that I am writing. I could of course just loop through twice and write the data, but I was hoping to do it in one pass.
This is an example of what I am doing (lot of complexity removed).
Sub WriteData()
WriteOutDivision "Division1",10
WriteOutDivision "Division1",20
End Sub
Private Sub WriteOutDivision(ByVal divisionName, ByVal rowNumber)
Dim curSheet As Worksheet
Set curSheet = Sheets("Company Scorecard")
With curSheet.Cells(rowNumber, 1)
.value = divisionName
.Font.Bold = True
.InsertIndent 1
End With
End Sub
Is there something that I can do to write to both row 10 column 1 and row 20 column 1 at the same time?
You could define a non-contigous range and change the propeties of the range. For example:
Dim curSheet As Worksheet
Dim rngSpecial As Range
Set curSheet = Sheets("Company Scorecard")
Set rngSpecial = curSheet.Range("A1,A3")
rngSpecial.Value = "Whatever"
Will write "Whatever" in A1 and A3.
Could you just pass an array of row numbers instead of one rowNumber, then in your function just loop through each element in the array (I don't remember, I haven't programed in VBA for a while)? Then you could print it to as many rows as you want.

Resources