Hi'm new to VBA and i'm trying to work on a QA report(call audit) that will automatically calculate values based on the data of another worksheet. I have 2 Sheets: Elements which contains the data, and AutoMacro which shows the number of cells that meets a specific criteria.
The Elements sheet has columns named Element and Rate, and WeekNumber. I made a code that will list all distinct week numbers to the "AM" column of the Automacro Sheet. Now, i want to count how many calls got a rate of 'Developing'(which is in column Rate of the Elements sheet) in Compassion(which is in column Element of the Elements sheet) on a specific week(AM column in the AutoMacro Sheet)
this code works fine:
CompDevCount = Application.WorksheetFunction.CountIfs( _
Sheets("Elements").Range("f2:F1048576"), "Compassion", _
Sheets("Elements").Range("G2:G1048576"),"Developing", _
Sheets("Elements").Range("C2:C1048576"), "4")
however, instead of putting a fixed value in the last criterion which is the weeknumber, i want my code to get the value of the corresponding cell in column AM(if macro is calculating values for row2 in the AutoMacro sheet, it should change the "4" to whatever value AM2 has) and i cant figure out how to do it.
any help is greatly appreciated
here's a link to my sample file:
https://drive.google.com/file/d/1ZXuMsQv_mzvycPXnGCGY7bUL6-gWBrBr/view?usp=sharing
Try the code bellow:
Sub LetsCount()
Dim lastElementsRowIndex As Long
Dim wsElements As Worksheet
Dim wsAutoMacro As Worksheet
Dim elementRange As Range
Dim rateRange As Range
Dim weekRange As Range
Dim i As Long
Dim weekNumber As Integer
Set wsElements = Sheets("Elements")
Set wsAutoMacro = Sheets("AutoMacro")
'//Get the index of the last filled row based on column A (Analyst)
lastElementsRowIndex = wsElements.Cells(Rows.Count, "A").End(xlUp).Row
'//Get ranges
Set elementRange = wsElements.Range("F2:F" & lastElementsRowIndex)
Set rateRange = wsElements.Range("G2:G" & lastElementsRowIndex)
Set weekRange = wsElements.Range("C2:C" & lastElementsRowIndex)
'//Looping through all filled rows in the AutoMacro sheet
For i = 2 To wsAutoMacro.Cells(Rows.Count, "A").End(xlUp).Row
'//Get week number from cell in column "AM"
weekNumber = wsAutoMacro.Cells(i, "AM").Value
'//Get the number of calls with: Rate = 'Developing', Element = 'Compassion' and Week Number = weekNumber
CompDevCount = Application.WorksheetFunction.CountIfs( _
elementRange, "Compassion", _
rateRange, "Developing", _
weekRange, weekNumber)
'//Insert the value in the corresponding cell of the AN column (column that I adopted to put the value)
wsAutoMacro.Cells(i, "AN").Value = CompDevCount
Next
End Sub
Related
I'm very new to Excel VBA and I'm trying to getting figure out certain things. I want to populate cells in a range K26:K386 with a value that comes from cell N47 (call it "Income)". The cell to be populated (among those rows in K26:386) is determined by a number in cell N46 (call it "Month"). "Income" can be any figure. "Month" can be any figure from 1 to 360.
I want to plug in two inputs into cells N47 and N46 - income and the respective month - such that the respective cell in range K26:K386 is populated with the "Income" value for the respective month from 1 to 360. Can somebody please advise?
I only know how to populate a single cell like this:
Sub Ievietot()
Dim Sum As Integer
Sum = Range("N47").Value
Range("K30").Value = Sum
End Sub
you could use
Range("K26:K386").Cells(Range("N46").Value) = Range("N47").Value
I think that this can be done as follows:
Sub CopyData()
Dim iMonthNum as Integer
Dim income as Integer
iMonthNum = Range("N46").Value
income = Range("N47").Value
Range("K" & (25 + iMonthNum)).Value = income
End Sub
I'm very new to using VBA with my excel workbooks.
I came across the following piece of code that #Manhattan provided as an answer to another question. It suits the needs of my workbook perfectly, but I need help with setting up a dynamic range.
What I am struggling to do now, is make the code only fill down enough rows to match up with the rows in column P (Which is the Row Labels column of the pivot table which the code below is pulling data from), except for the very last row (which is always "Grand Totals")?
Sub FillDown()
Dim strFormulas(1 To 3) As Variant
With ThisWorkbook.ActiveSheet
strFormulas(1) = "=SUM($Q3:$S3)"
strFormulas(2) = "=iferror(index(q3:s3,match($AE$2,$Q$2:$S$2,0)),0)"
strFormulas(3) = "=$AD3-$AE3"
.Range("AD3:AF3").Formula = strFormulas
.Range("AD3:AF150").FillDown
End With
End Sub
TL;DR: How can I make this code only fill down enough rows to match the last row -1 in column P?
Dynamically find the last row of column P (LR):
Dim LR as Long
LR = .Cells( .Rows.Count, "P").End(xlUp).Row
Then apply the last row minus 1 to your filldown:
.Range("AD3:AF" & LR-1).FillDown
I have an Excel table with a sheet "CR" where columns A to K are filled, with the first row being a header row.
Rows 1-1000 are formatted (borders) and column A contains a formula to autonumber the rows when data in column F is entered.
Sheet "CR" is protected to prevent users from entering data in column A (locked).
Using the Workbook_BeforePrint function, I'm trying to set the print area to columns A to K and to the last row of column A that contains a number.
My code (in object 'ThisWorkbook') is as follows:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("CR")
' find the last row with data in column A
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
ws.PageSetup.PrintArea = ws.Range("A1:K" & lastRow).Address
End Sub
However, when I click File -> Print, the range of columns A to K up to row 1000 is displayed instead of only the rows that have a number in column A. What am I doing wrong?
Change:
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
To:
lastRow = [LOOKUP(2,1/(A1:A65536<>""),ROW(A1:A65536))]
.End(...) will act like ctrl + arrow-key. if the cell has a formula (which looks empty due to the formula, then it will still stop there... another way would be the use of evaluate (if you do not want to loop) like this:
lastRow = .Evaluate("MAX(IFERROR(MATCH(1E+100,A:A,1),0),IFERROR(MATCH(""zzz"",A:A,1),0))")
This will give the last row (which has a value in column A).
Also check if there are hidden values (looking empty due number format or having characters you can't see directly. Try to go below row 1000 in column A (select a cell after A1000 in column A) and hit ctrl+up to validate where it stops (and why).
EDIT:
(regarding your comment)
"" still leads to a "stop" for the .End(...)-command. So either use my formula, translate the formula into vba or loop the cells it get the last value. Also Find is a good tool (if not doing it over and over for countless times).
lastRow = .Cells.Find("*", .Range("B1"), xlValues, , xlByColumns, xlPrevious).Row
Currently I have a medical spread-sheet with a list of clients that we have serviced. We have 8 different clinical categories which are denoted by different acronyms - HV,SV,CV,WV,CC,OV,TS and GS.
A client can receive multiple therapies i.e. HV,SV,CV - in the background we have a counter mechanism which would increment each of these records by 1.The formula used for this counter is:
=(LEN('Parent Sheet'!F25)-LEN(SUBSTITUTE('Parent Sheet'!F25,'Parent Sheet'!$P$4,"")))/LEN('Parent Sheet'!$P$4)
At the bottom of the sheet we then have a sum which ads up all the treatments that occurred for that week.
Now the tricky part about this is that we have almost a year's worth of data in this sheet but the summing formulas are set as: SUM(COLUMN 6: COLUMN 53) but due to a need to increase the entries beyond this limit, we have to adjust the sum formula. We have 300 SUM Formulas adding up each of the 8 Criteria items and assigning them to the HV,SV,SC,WV etc. counters.
Would we have to adjust this manually one by one or is there a easier way of doing this?
Thank you very much!
To me, I think you should change the sheet layout a little, create a User Defined Function (UDF) and alter the formulas in your Sum rows for efficient row/column adding (to make use of Excel's formula fill). The only issue is that you need to save this as a Macro-Enabled file.
What you need to change in the formulas is to utilize $ to restrict changes in column and rows when the formula fill takes place.
To illustrate in an example, consider:
Assuming the first data starts at row 6, and no more than row 15 (you can use the idea of another data gap on the top). Alter the Sum row titles to begin with the abbreviation then create a UDF like below:
Option Explicit
' The oRngType refers to a cell where the abbreviation is stored
' The oRngCount refers to cells that the abbreviation is to be counted
' Say "HV" is stored in $C16, and the cells to count for HV is D$6:D$15,
' then the sum of HV for that date (D16) is calculated by formula
' `=CountType($C16, D$6:D$15)`
Function CountType(ByRef oRngType As Range, ByRef oRngCount) As Long
Dim oRngVal As Variant, oVal As Variant, oTmp As Variant, sLookFor As String, count As Long
sLookFor = Left(oRngType.Value, 2)
oRngVal = oRngCount.Value ' Load all the values onto memory
count = 0
For Each oVal In oRngVal
If Not IsEmpty(oVal) Then
For Each oTmp In Split(oVal, ",")
If InStr(1, oTmp, sLookFor, vbTextCompare) > 0 Then count = count + 1
Next
End If
Next
CountType = count
End Function
Formulas in the sheet:
Columns to sum are fixed to rows 6 to 15 and Type to lookup is fixed to Column C
D16 | =CountType($C16,D$6:D$15)
D17 | =CountType($C17,D$6:D$15)
...
E16 | =CountType($C16,E$6:E$15)
E17 | =CountType($C17,E$6:E$15)
The way I created the UDF is to lookup and count appearances of a cell value (first argument) within a range of cells (second argument). So you can use it to count a type of treatment for a big range of cells (column G).
Now if you add many columns after F, you just need to use the AutoFill and the appropriate rows and columns will be there.
You can also create another VBA Sub to add rows and columns and formulas for you, but that's a different question.
It's isn't a great idea to have 300 sum formulas.
Name your data range and include that inside the SUM formula. So each time the NAMED data range expands, the sum gets calculated based on that. Here's how to create a dynamic named rnage.
Sorry I just saw your comment. Following is a simple/crude VBA snippet.
Range("B3:F12") is rangeValue; Range("C18") is rngTotal.
Option Explicit
Sub SumAll()
Dim WS As Worksheet
Dim rngSum As Range
Dim rngData As Range
Dim rowCount As Integer
Dim colCount As Integer
Dim i As Integer
Dim varSum As Variant
'assuming that your said mechanism increases the data range by 1 row
Set WS = ThisWorkbook.Sheets("Sheet2")
Set rngData = WS.Range("valueRange")
Set rngSum = WS.Range("rngTotal")
colCount = rngData.Columns.Count
'to take the newly added row (by your internal mechanism) into consideration
rowCount = rngData.Rows.Count + 1
ReDim varSum(0 To colCount)
For i = 0 To UBound(varSum, 1)
varSum(i) = Application.Sum(rngData.Resize(rowCount, 1).Offset(, i))
Next i
'transpose variant array with totals to sheet range
rngSum.Resize(colCount, 1).Value = Application.Transpose(varSum)
'release objects in the memory
Set rngSum = Nothing
Set rngData = Nothing
Set WS = Nothing
Set varSum = Nothing
End Sub
Screen:
You can use named ranges as suggested by bonCodigo or you could use find and replace or you can insert the columns within the data range and Excel will update the formula for you automatically.
This site already has something similar: Copy and insert rows based off of values in a column
but the code doesn't take me quite where I need to go, and I haven't been able to tweak it to make it work for me.
My user has a worksheet with 4 columns, A-D. Column A contains specific contract numbers, column B is blank, column C has part numbers, and column D has the entire range of contract numbers. My user wants to count the number of times the entire range contract numbers has duplicates so I entered the formula =countif($D$2:$D$100000,A2) in cell E2 and copied down, giving me the number of times the specific contract in column A appears in column D. The numbers range from 1 to 11 in this workbook but the number may be higher in other workbooks this method will be used in.
The next thing I need to do is to enter blank cells below all values in column E that are greater than 1, very much like the example in the previously asked question. I then also need to copy in the same row and insert copied cells exactly to match in the same row in column A. Example: Cell E21 has the number 5 so I need to shift cells in column E only so that there are 4 blanks cells directly below it. In column A, I need to copy cell A21 and insert copied cells in four rows directly below.
Just trying to get the blank cells to insert has been a trial, using the code as given in the previous question.
Dim sh As Worksheet
Dim lo As ListObject
Dim rColumn As Range
Dim i As Long
Dim rws As Long
Set sh = ActiveSheet
Set lo = sh.ListObjects("Count")
Set rColumn = lo.ListColumns("Count").DataBodyRange
vTable = rColumn.Value
For i = rColumn.Rows.Count To 1 Step -1
If rColumn.Cells(i, 1) > 1 Then
rws = rColumn.Cells(i, 1) - 1
With rColumn.Rows(i)
.Offset(1, 0).Resize(rws, 1).Cells.Insert
.EntireRow.Copy .Offset(1, 0).Resize(rws, 1).Cells
.Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True
End With
End If
Next
I would be very grateful for any help as I have been fighting with this monster for a week.
While this is indeed possible to do, it might be a good idea to look into moving the list of all contract numbers from column D to a different sheet. Even though it is quite simple to loop through a range and insert rows based on cell values - it'll also create holes in columns D and E.
Here's code for simply adding the rows and copying the values as you specified.
Sub Main()
'---Variables---
Dim source As Worksheet
Dim startRow As Integer
Dim num As Integer
Dim val As String
Dim i As Long
'---Customize---
Set source = ThisWorkbook.Sheets(1) 'The sheet with the data
startRow = 2 'The first row containing data
'---Logic---
i = startRow 'i acts as a row counter
Do While i <= source.Range("E" & source.Rows.Count).End(xlUp).Row
'looping until we hit the last row with a value in column E
num = source.Range("E" & i).Value 'Get number of appearances
val = source.Range("A" & i).Value 'Get the value
If num > 1 Then 'Number of appearances > 1
Do While num > 1 'Create rows
source.Range("A" & i + 1).EntireRow.Insert 'Insert row
source.Range("A" & i + 1) = val 'Set value
num = num - 1
i = i + 1 'Next row
Loop
End If
i = i + 1 'Next row
Loop
End Sub
Of course you could also remove the holes from column D after inserting the new rows and modify the formula in column E so that it remains copyable and doesn't calculate for the copied rows.
Generally it makes things easier if a single row can be thought of as a single object, as creating or deleting a row only affects that one single object. Here we have one row represent both a specific contract and a contract in the all contracts list - this could end up causing trouble later on (or it could be totally fine!)