custom made functions in VBA - vba

I have a list of films and their durations in minutes. I wish to create a custom function whereby the user selects the range of durations i.e. one or more cells. The function converts the duration in minutes into " x hours and y minutes form ".
I have created the following function but it does not seem to take more than 1 cell reference at a time.
Function Saikatrealtime(cell As Range) As String
Dim r As String
r = Int(cell.Value / 60) & " hours " & " & " & cell.Value Mod 60 & " minutes "
Saikatrealtime = r
End Function
Sub realtimesof_film()
Dim rng As Range
Dim t As String
s1.Activate
Set rng = Application.InputBox(prompt:=" enter range ", Type:=8)
t = Saikatrealtime(rng)
rng.Offset(0, 2).Value = t
End Sub
Whenever I give a reference to rng as 2 or more cells, it gives the error type mismatch at the line
r = Int(cell.Value / 60) & " hours " & " & " & cell.Value Mod 60 & " minutes "
Can anyone please tell me how I can modify the code so that the function runs across multiple cell references given to rng?

Unless you change the formula to return an array of values, you'll have to modify the subroutine code to reference multi-cell ranges. Adding a loop of the cells within the range will work. Add this to your subroutine:
Dim Cell As Range
For Each Cell In rng.Cells
Cell.Offset(0, 2).Value = Saikatrealtime(Cell)
Next Cell

There is no need for the custom function Saikatrealtime. You can use Format instead. The key is that you have to escape certain letters in the text using a backslash \
Sub realtimesof_film()
Dim rng As Range
Dim c As Range
Set rng = Application.InputBox(prompt:=" enter range ", Type:=8)
For Each c In rng
c.Offset(0, 2).Value = Format(c.Value, "HH \hour\s & MM \mi\nute\s ")
Next
End Sub

Related

How can I insert a dynamic last row into a formula?

I'm working with a clean sheet where I paste one column of dates with a varying number of rows. My goal is to show how many times each date shows up. However, every time I get to the last line I keep getting Run-time error '1004' Application-defined or object-defined error.
Here is my code:
Dim lastrow As Long
Set ws = ActiveSheet
Set startcell = Range("A1")
lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
Range("B2").Formula = "=countif(A1:" & lastrow & ")"
Thanks in advance!!
COUNTIF function takes 2 arguments (https://support.microsoft.com/en-us/office/countif-function-e0de10c6-f885-4e71-abb4-1f464816df34), not one as in your code. Also missed column letter in range. If you want to process N dates, you have to make N formulas COUNTIF.
Try this code (dates in column A from A1, formulas in column B):
Sub times()
With ActiveSheet
Intersect(.Columns(1), .UsedRange).Offset(0, 1).FormulaR1C1 = "=COUNTIF(C[-1],RC[-1])"
End With
End Sub
Result:
SOLVED! 4 WAYS
High-level
Countif formula is incorrect (missing: col label A + condition)
Outlook: quick to fix, but requires loop for all dates
Current method may be CPU/time-intensive for large lists
Solutions A-D:
See Below (Links section), for google sheets (with full macro code, descriptions) for 4 solutions (3 macro based + 1 macro-free albeit dynamic soln). Briefly:
A: output with correction to your code
B: as for A, with for loop deployed
C: VB code for much quicker implementation of for loop/.Function code
D: macro-free variant (proposed/preferred)
Screenshots
Comparison table
Links:
Google Sheet
VBA count and sumifs - Automate Excel
VB code (A-C)
For completeness (same can be found in linked Google Sheet, typed - so macro-free / safe workbook):
Sub Macro_A():
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
cell = Range("a4").Address
Range("B4").Value = "=countif(A1:" & "A" & lastrow & "," & cell & ")"
' For i = 1 To lastrow - Range(cell).Row + 1
' Range("B4").Offset(i - 1).Formula = "=countif(A1:" & "A" & lastrow & "," & Range(cell).Offset(i - 1).Address & ")"
' Next
End Sub
Sub Macro_B():
Application.Calculation = xlCalculationManual
start_time = Timer
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
cell = Range("a4").Address
' Range("B4").Value = "=countif(A1:" & "A" & lastrow & "," & cell & ")"
For i = 1 To lastrow - Range(cell).Row + 1
Range("c4").Offset(i - 1).Formula = "=countif(A1:" & "A" & lastrow & "," & Range(cell).Offset(i - 1).Address & ")"
Next
Application.Calculation = xlCalculationAutomatic
Range("c3").End(xlDown).Offset(2).Value = Round(Timer - start_time, 2)
End Sub
Sub Macro_C():
start_time = Timer
Set Rng = Range("A4", Range("A4").End(xlDown))
For Each cell In Rng
cell.Offset(0, 3) = WorksheetFunction.CountIf(Rng, cell.Value)
Next
Range("d3").End(xlDown).Offset(2).Value = Round(Timer - start_time, 2)
End Sub
Macro-free soln (D)
Go to Formulas (ribbon), Name Manager:
In Name Manager window that apperas, click 'New...'
Populate dialogue box as req. (modifying Sheet name and $A$4 starting cell as req.)
Test your new dynamic range by clicking on upward arrow in bottom right hand corner (which should select dates in column A as depicted below)
Enter single formula in first cell of output range (here, cell D4)*:
Formulae (for convenience):
range_countif:
=Sheet1!$A$4:OFFSET(Sheet1!$A$4,COUNTA(Sheet1!$A:$A)-2,0,1,1)
Entry in cell D4
=COUNTIF(range_countif,range_countif)
*Notes: requires Office 360 for 'spill effect' (input as array formula with 'ctrl' + 'shift' + 'enter' otherwise).
Let me know if you have any further Qs. Best of luck with your excel Spreadsheet!
So many ways to achieve. I use this formula to get the number of rows
=ArrayFormula(MAX(IF(L2s!A2:A1009<>"",ROW(2:1011))))
Then I build a string from it
="L2s!A2:E"&D3
I love named ranges so I named the cell with the string built DynamicRangeL2s
Here is how I used the dynamic range in my formula (denormalize() is a custom function I wrote but could be any function) using the INDIRECT() function
=denormalize(INDIRECT(DynamicRangeL2s),INDIRECT(DynamicRangeSchedule),2,2,"right")
Here is a great article on Dynamic Ranges
https://www.benlcollins.com/formula-examples/dynamic-named-ranges/

excel vba - Using autofilter - can't pass the filtered range to a sub, it keeps passing the entire sheet range

I can't seem to figure this one out. I have a function and a sub where I call the function to get the unique values (from column N (text values)) from the range I've already selected from the autofilter. Somehow, the range keeps being the entire sheet range and not the selected.
Function UniquesFromRange(rng As Range)
Dim d As Object, c As Range, tmp
Set d = CreateObject("scripting.dictionary")
For Each c In rng.Cells
tmp = Trim(c.Value)
If Len(tmp) > 0 Then
If Not d.Exists(tmp) Then d.Add tmp, 1
End If
Next c
UniquesFromRange = d.Keys
End Function
Sub mainSub()
For Each key In fCatId.Keys
With wshcore
llastrow = wshcore.Range("A" & Rows.Count).End(xlUp).Row
.AutoFilterMode = False
.Range("A1:N" & llastrow).AutoFilter
.Range("A1:N" & llastrow).AutoFilter Field:=1, Criteria1:=fCatId(key)
lwmin = WorksheetFunction.Subtotal(5, Range("H:H"))
lwmax = WorksheetFunction.Subtotal(4, Range("H:H"))
'This does not work, I want to get the unique values from column N
'that are already in the filtered range. So far this shows
'all the values in the column not only the ones already filtered.
varArray = UniquesFromRange(Range("N:N"))
'I've also tried this:
'varArray = UniquesFromRange(Range.Cells)
'Debug.Print fCatId(key) & " - " & key & " " & lwmin & "-" & lwmax & fData(key) & " - " & Join(varArray, vbNewLine)
End With
Next key
Application.ScreenUpdating = True
End Sub
any suggestions?
Instead of
varArray = UniquesFromRange(Range("N:N"))
use
varArray = UniquesFromRange(Range("N1:N" & llastrow).SpecialCells(xlCellTypeVisible))
In response to the additional question asked in the comments, you could copy varArray to another sheet (assumed to already exist, and being referred to by the object wsOutput, and output to be written to column A) as follows
Dim r as Integer
For r = LBound(varArray) To UBound(varArray)
wsOutput.Cells(r, 1).Value = varArray(r)
Next

How do I get a cell's position within a range?

How would I go about getting the relative position of a cell within a range? Finding the position of a cell in a worksheet is trivial, using the Row- and Column-properties, but I am unsure of how to do the same within a range.
I considered using the position of the top-left cell in the range I want to find the position of a cell in, and just deduct it (-1) from the position of the cell in the worksheet, but it gets a little bit cumbersome. Is there a more elegant way to go about this?
My best attempt, including a test, so far is this:
Option Explicit
Sub test()
Dim r As Range: Set r = Sheet1.Range("B2:E10")
Dim c As Range: Set c = Sheet1.Range("C2")
Debug.Print "Column in sheet: " & c.Column
Debug.Print "Row in sheet: " & c.Row
Debug.Print "Column in range: " & column_in_range(r, c)
Debug.Print "Row in range: " & row_in_range(r, c)
End Sub
Function column_in_range(r As Range, c As Range) As Long
column_in_range = c.Column - (r.Cells(1, 1).Column - 1)
End Function
Function row_in_range(r As Range, c As Range) As Long
row_in_range = c.Row - (r.Cells(1, 1).Row - 1)
End Function
This gives the desired output:
Column in sheet: 3
Row in sheet: 2
Column in range: 2
Row in range: 1
But I wonder if there are any native functions I can use instead?
updated using variant provided by lori_m
But I wonder if there are any native functions ...
use this
Sub test()
Dim r As Range, c As Range
With Sheet1
Set r = .[B2:E10]
Set c = .[C2]
End With
If Not Intersect(r, c) Is Nothing Then
Debug.Print "Column in sheet: " & c.Column
Debug.Print "Row in sheet: " & c.Row
Debug.Print "Column in range: " & Range(r(1), c).Columns.Count
Debug.Print "Row in range: " & Range(r(1), c).Rows.Count
End If
End Sub
output
Column in sheet: 3
Row in sheet: 2
Column in range: 2
Row in range: 1
There is no native way to do it. I also do what you have mentioned in the code above. However I put some extra checks.
Sub test1()
Dim r As Range: Set r = Sheet1.Range("B2:E10")
Dim c As Range: Set c = Sheet2.Range("C2") '<~~ Changed Sheet1 to sheet2
Dim rng As Range
On Error Resume Next
Set rng = Intersect(c, r)
On Error GoTo 0
'~~> Check if the range is in main range
If Not rng Is Nothing Then
'
'~~> Rest of your code
'
Else
MsgBox c.Address & " in " & c.Parent.Name & _
" is not a part of " & _
r.Address & " in " & r.Parent.Name
End If
End Sub
In my opinion there is almost native way to check it but result is a string required some additional manipulation. All you need to use is a proper construction of .Address property (according to MSDN). Some examples:
Dim r As Range: Set r = Sheet1.Range("B2:E10")
Dim c As Range: Set c = Sheet1.Range("c2")
Debug.Print c.Address(False, False, xlR1C1, , r.Cells(0, 0))
'>>result: R[1]C[2]
'-----------------------------------------------------
Set c = Sheet1.Range("e2")
Debug.Print c.Address(False, False, xlR1C1, , r.Cells(0, 0))
'>>result: R[1]C[4]
'-----------------------------------------------------
Set c = Sheet1.Range("e5")
Debug.Print c.Address(False, False, xlR1C1, , r.Cells(0, 0))
'>>result: R[4]C[4]
'-----------------------------------------------------
Take a look on MSDN to see more.
You can use something like :
MsgBox ActiveCell.Address(RowAbsolute:=True, _
ColumnAbsolute:=True, _
ReferenceStyle:=xlR1C1, _
External:=False, _
RelativeTo:=Range("B2"))
'Or shorter version :
MsgBox ActiveCell.Address(, , xlR1C1, False, Range("B2"))
But you'll have both information about row and column in the range, but not separately.
So you'll still need to extract these values from the answer (look like : R18C20) in two functions, so almost the same issue...
I'm not totally sure if this is what you are after.
But here it goes:
Sub ts2()
Dim test As Range
Set test = Range("B2:E10")
Dim topcorner As Range
Dim testcell As Range
Set topcorner = Cells(test.Row, test.Column)
Set testcell = Range("D7")
rel_row = testcell.Row - topcorner.Row
rel_col = testcell.Column - topcorner.Column
End Sub
By this, you will find the relative position.
But maybe you were looking for some built in function ?
If this was not the thing you were after, please edit your post...

countif outputting "true" or "false" rather than number vba

I have been trying to code a countif function into a loop, however, I am having a little trouble with the outputs. Instead of reading a number when the computation occurs, the function keeps outputting "true" or "false". Maybe there is an error in my code, but I have used many countif functions in the past without experiencing a problem such as this. As you can see below, I tried to write the function in two different ways, but both either didn't work or outputted "true" or "false".
Please Help.
Sub CorrectSets()
Dim Cell As Range
Range("B100000").End(xlUp).Select
LastRow = ActiveCell.Row
For Each Cell In Range("S2:S" & LastRow)
StartTime = Cell.Offset(0, -12)
Shift = Cell.Offset(0, -14)
SortedOp = Cell.Offset(0, -17)
DOW = Cell.Offset(0, -5)
'Cell.Value = CountIF(E2:E & LastRow, Shift, N2:N & LastRow ,DOW, B2:B & LastRow,SortedOp, G2:G & LastRow, " < " & StartTime)
Cell.Value = "=CountIF(E2:E" & LastRow & ", " & Shift & ", N2:N" & LastRow & "," & DOW & ", B2:B" & LastRow & "," & SortedOp & ", G2:G" & LastRow & ", " < " " & StartTime & ")"
Next Cell
If you want to put a countif() Formula in Cell then:
Cell.Formula = "=CountIF(E2:E &...............
If you want to put the formula's result in Cell then:
Cell.Value = Application.Worksheetfunction.CountIF(E2:E &....................
You should use
Cell.Formula = "=CountIFs..."
or
Cell.Value = WorksheetFunction.CountIfs...
See official documentation.
Plus:
To find the last row containing data in a column (B in this case) use
Dim ws as Worksheet
Set ws = ActiveSheet
Dim LastRow as Long
LastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
ws is a reference to the Worksheet of interest (ActiveSheet in my example).
See this answer.
You'd rather fully qualify your ranges, and avoid using Select unless it is strictly needed.
With the code posted above,
Range("B100000").End(xlUp).Select
might not be needed.
If using Cell.Formula = "=CountIFs...", it might be convenient to use
Dim frm as String
frm = "=CountIFs..."
Cell.Formula = frm
for easier debugging.

Replace an entire coloumn in excel with a new value automatically

I have VBA code which converts a given specific date format into a normal Date. Is there a way in which I can replace the entire column into my new date format may be by a button click or just using a function.
The code I have is:
Function CONVDATE(myDate) As Date
Dim arr
arr = Split(myDate)
CONVDATE = arr(1) & " " & arr(2) & " " & arr(5) & " " & arr(3)
End Function
Immediately to the right of your data enter:
=TEXT(LEFT(A1,11)&RIGHT(A1,4),"ddd mm dd yyyy")
and double-click the fill handle. Then select, Copy and Paste Special Values over the top.
If you want a VBA solution, and you are happy with your CONVDATE function, you can use something like the following to convert an entire column:
===================================
Option Explicit
Sub CONVALLDATES()
Dim RNG As Range, C As Range
'Next line may change depending on how your range to convert is set up
Set RNG = Range("A1", Cells(Rows.Count, "A").End(xlUp))
'Uncomment next line when debugged.
'application.ScreenUpdating = False
For Each C In RNG
With C
.Value = CONVDATE(C)
'.numberformat = whatever format you want it displayed
End With
Next C
Application.ScreenUpdating = True
End Sub
'---------------------------------------------
Function CONVDATE(myDate) As Date
Dim arr
arr = Split(myDate)
CONVDATE = arr(1) & " " & arr(2) & " " & arr(5) & " " & arr(3)
End Function
====================================
You should add some error checking to ensure the string you are trying to convert is, indeed, in the specific format.