I'm trying to extract the numerator and denominator of a range of cells using VBA.
So for example, in cell A1 the formula is: =NV2/NV3. NV2 and NV3 are named values and are for example NV2 = 3 and NV3=6. In text, the result of the formula in A1 would be 0.5.
What would be the approach to retrieve NV2 and NV3? I need to somehow make reference to the formula I believe.
Many thanks for your help.
Select the cells you wish to examine and run:
Sub marine()
Dim r As Range
For Each r In Selection
v = r.Formula
If r.HasFormula And InStr(v, "/") > 0 Then
ary = Split(Mid(v, 2), "/")
msg = r.Address & vbCrLf & v & vbCrLf & ary(0) & vbCrLf & ary(1)
MsgBox msg
End If
Next r
End Sub
Related
I would need to replace the line breaks in a cell, with a line break and the content of a cell in the same column of the active cell.
The code would be something like this:
For i = LBound(arColumns) To UBound(arColumns)
'ActiveColumn = arColumns(i)
Set rng = Range(arColumns(i))
For Each Cell In rng.Cells
If Cell.row > 4 And Cell.row < r Then
colnum=cell.column
Cell.value = "{Something}" & Cells(3, colnum).value & _
", text here{/something}" & Cell.value 'First line in the cell
cell.replace what:=vbCrLf, replacement:=vbCrLf & "{Something}" & _
Cells(3, colnum).value & ", text here{/something}" 'First try
Cell.value = Application.WorksheetFunction.Substitute(CStr(Cell.value), vbCrLf, vbCrLf & _
"{maxlen}{/maxlen}{notes}" & ", No Max length{/notes}") 'Second try
End If
Next
Next
I've tried to replace the values of the line breaks with the two methods, replace and substitute. None of them have been working or I am doing something wrong with this block of code.
The array arColumns have the range of columns that I want to work, for example: B:C,E:E,M:O,Z:AB...
along with the vbLf fix you've already been told, you could refactor your code as follows:
Option Explicit
Sub main()
Dim arColumns As Variant
Dim cell As Range
Dim r As Long, i As Long
arColumns = Array("B:C", "E:E", "M:O", "Z:AB")
r = 10 '<--| just to have a value to test with
For i = LBound(arColumns) To UBound(arColumns)
For Each cell In Intersect(Range(arColumns(i)), Rows("4:" & r)).SpecialCells(xlCellTypeConstants) '<--| loop through current columnns group not empty cells from row 4 to 'r'
cell.Replace what:=vbLf, replacement:=vbLf & "{Something}" & Cells(3, cell.Column).Value & ", text here{/something}" 'First try
Next
Next
End Sub
I need to insert an array formula at numerous cells to first round and then sum cells in a range. However, the range is not always the same and hence, I'll have to pull in row numbers defining the range from variables. This doesn't seem to work:
Set ssheet = ThisWorkbook.Sheets("1 to 50")
With ssheet.Range(Cells(1, 8), Cells(3200, 8))
Set x = .Find("Rate", LookIn:=xlValues, Lookat:=xlWhole)
tworow = x.Row
Set y = .Find("Total=", LookIn:=xlValues, Lookat:=xlWhole)
nextrow = y.Row
End With
l = tworow + 1
m = nextrow - 1
ssheet.Cells(nextrow, 9).FormulaArray = "=sum(round("I" & l & ":" & "I" &m,2))"
End sub
I can select the desired range by this:
myrange = "I" & l & ":" & "I" & m
Range(myrange).Select
But the code for sum formula gives out "Expected end of statement". Please help.
You need to sort out what how your string is made up, i.e. what should literally appear. Try this
ssheet.Cells(nextrow, 9).FormulaArray = "=sum(round(I" & l & ":I" & m & ",2))"
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
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
I want to iterate through data (simular to that shown below) that is stored in different cells and combine them into a single cell seperated by a new line (chr(10)). The amount of data that needs to be imported into one cell will change.
2991
19391
423
435
436
The code needs to iterate through the whole sheet regardless of any line breaks. The required format is:
2991 - all three cells would be combined into one cell in the next column to this one.
19391
423
-Line space, this will need to be taken into account and is the seperator of data.
26991 - all four cells would be combined into one cell in the next column to this one.
19331
424
6764
Below is what I have got so far, it takes the column to the left of the current row and combines it, which is wrong.
Sub ConcatColumns()
Do While ActiveCell <> "" 'Loops until the active cell is blank.
ActiveCell.Offset(0, 1).FormulaR1C1 = _
ActiveCell.Offset(0, -1) & chr(10) & ActiveCell.Offset(0, 0)
ActiveCell.Offset(1, 0).Select
Loop
End Sub
You can achieve the above with this code
Sub Main()
Dim i As Long
Dim c As Range
For i = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
Dim strBuilder As String
Set c = Range("A" & i)
If Not IsEmpty(c) And i <> 1 Then
strBuilder = c & Chr(10) & strBuilder
ElseIf i = 1 Then
strBuilder = c & Chr(10) & strBuilder
c.Offset(0, 1) = Left(strBuilder, Len(strBuilder) - 1)
strBuilder = vbNullString
Else
c.Offset(1, 1) = Left(strBuilder, Len(strBuilder) - 1)
strBuilder = vbNullString
End If
Next i
End Sub
I think this could be done using a UDF.
Something like
Public Function JoinValues(rng As Range) As String
Dim cell As Range
Dim str As String
For Each cell In rng
If cell.Value <> "" Then
str = str & cell.Value & Chr(10)
End If
Next cell
If Len(str) > 1 Then JoinValues = Left(str, Len(str) - 1)
End Function
Then usage would be =JoinValues(A1:A10) in a cell to join values. You would also have to change cell formatting in the target cell to allow wrapping text for this to work properly.
Assuming your values start in cell A2 enter
=IF(A1="",joinvalues(OFFSET(A2,0,0,MATCH(TRUE,INDEX(ISBLANK(A2:A10000),0,0),0)-1)),"")
in B2 and drag the function down.