I need to get ranges from pre-set columns and a row from a variable. If i try to get this range by hand everything works. How do i get the same range using the variable?
How do i get from:
Dim j As Integer
j = 20
MsgBox Union(Sheets("Temp").Range("H10:H20"), _
Sheets("Temp").Range("K10:K20")).Address
... to something like this: (only that it works?)
MsgBox Union(Sheets("Temp").Range("H10:H" & j ), _
Sheets("Temp").Range("K10:K" & j)).Address
Here you go:
Option Explicit
Public Sub TestMe()
Dim j As Long
j = 20
MsgBox Union(Sheets(1).Range("H10:H" & j), _
Sheets(1).Range("K10:K" & j)).Address
End Sub
Result:
I think what you're asking is how you change j (20) into a dynamic variable? if so, something like this will do it:
Option Explicit
Public Sub TestMe()
Dim j As Long
j = Range("H10").End(xlDown).Row
MsgBox Union(Sheets(1).Range("H10:H" & j), _
Sheets(1).Range("K10:K" & j)).Address
End Sub
Please note: it there's an empty cell in the H column then j will be the row immediately above it - a work-around this would be j = Range("H" & Columns("H:H").Rows.Count).End(xlUp).Row
Related
The below code is working fine with me. I need your help and support to make it a function so I can for example write in any cell
=adj() or =adj(A1) and the formula will apply,
Sub adj()
Dim i, j As Integer
Sheet1.Select
With Sheet1
j = Range(ActiveCell.Offset(0, -2), ActiveCell.Offset(0, -2)).Value
For i = 1 To j
ActiveCell.Formula = "=" & Range(ActiveCell.Offset(0, -1), ActiveCell.Offset(0, -1)) & i & "))" & "&char(10)"
Next i
End With
End Sub
It's hard for me to definitively understand what you're trying to do here. I think you're trying to concatenate x number of cells with a separator field.
So, I would do the following changes... obviously you can change accordingly.
Declare the Inputs as variants. If you don't and get a type mismatch the function wont call in debug. This also gives you the opportunity to deal with the Inputs.
Put in an error handler to prevent unwanted debug w.r.t. a failure.
You can't use Evaluate that way. I think you're trying to get an Evaluation of cells like A1 etc.
The function has to be called from a Cell on a sheet since it uses Application.Caller. You shouldn't really need this for the function to work, but I put in in there in case you are calling via F9 calculation.
You can also put in the line if you want the calculation to occur every time you recalculate. However this should be used with caution since you can get some unwanted calculation side effects with some spreadsheets when using this.
Application.Volatile
Public Function Adj(ByVal x As Variant, ByVal y As Variant) As String
On Error GoTo ErrHandler
Dim sSeparator As String, sCol As String
Dim i As Integer
'Get the column reference.
sCol = Split(Columns(y).Address(False, False), ":")(1)
'Activate the sheet.
Application.Caller.Parent.Select
sSeparator = Chr(10)
For i = 1 To x
Adj = Adj & Evaluate(sCol & i) & sSeparator
Next
'Remove the last seperator...
Adj = Left(Adj, Len(Adj) - 1)
Exit Function
ErrHandler:
'Maybe do something with the error return value message here..
'Although this is a string, Excel will implicitly convert to an error.
Adj = "#VALUE!"
End Function
If you wanted to pass change to a formula, and pass in the range, you would use something like:
Public Function Func(Byval MyRange as range) as variant
In this case, you're not specifying a return value so it will be ignored.
Public Function Func(Byval MyRange as range) as variant
Dim i, j As Integer
With MyRange.parent
j = .Range(MyRange.Offset(0, -2), MyRange.Offset(0, -2)).Value
For i = 1 To j
MyRange.Formula = "=" & .Range(MyRange.Offset(0, -1), MyRange.Offset(0, -1)) & i & "))" & "&char(10)"
Next i
End With
End Sub
It would be something like that..
I am trying to order, from most senior downwards, a list of employees based on who their manager is. The tricky part is having all senior persons employees listed before moving on to the next person of the same level. For example see this image:
All people reporting to Dick, either directly or indirectly, are listed below him before moving on to Peter - the next person at his level.
So if the table looked like this:
Is there a VBA that will reorder the table to look like the first example? The table to be reordered may not look like this - it would have to work regardless of who it was wrongly ordered.
Note: The order of people at the same level is unimportant...
Thanks for your help.
I love stuff like this. Create an Excel sheet with two tabs, and name one "Input" and one "Output". Copy your example table into the "Input" then just the headers into "Output". Then plug the code below in. This should show you the idea, which is basic recursion. It's fairly horrible to do in VBA, it would be a lot prettier in C.
Option Explicit
Dim RawName() As Variant
Dim RawManager() As Variant
Dim RawLevel() As Variant
Dim TopNode As Integer
Sub FncSortHierarchy()
TopNode = FncPopulateRawHierarchy("A", "B", "C")
If TopNode <> 0 Then
Sheets("Output").Select
FncWritePerson (TopNode)
FncGetSubordinates (TopNode)
End If
End Sub
Private Function FncGetSubordinates(indexManager As Integer) As Integer
Dim i As Integer
Dim name As String
Dim manager As String
manager = RawName(indexManager)
For i = 1 To UBound(RawName)
If RawManager(i) = manager Then
name = RawName(i)
FncWritePerson (i)
FncGetSubordinates (i)
End If
Next i
End Function
Private Function FncWritePerson(index As Integer)
Dim nextRow As Integer
nextRow = ActiveSheet.UsedRange.Rows.Count + 1
Range("A" & nextRow) = RawName(index)
Range("B" & nextRow) = RawManager(index)
Range("C" & nextRow) = RawLevel(index)
End Function
Private Function FncPopulateRawHierarchy(nameCol As String, managerCol As String, levelCol As String) As Integer
Dim i As Integer
Sheets("Input").Select
ReDim RawName(ActiveSheet.UsedRange.Rows.Count)
ReDim RawManager(ActiveSheet.UsedRange.Rows.Count)
ReDim RawLevel(ActiveSheet.UsedRange.Rows.Count)
For i = 2 To ActiveSheet.UsedRange.Rows.Count
RawName(i - 1) = Range(nameCol & i).Value
RawManager(i - 1) = Range(managerCol & i).Value
RawLevel(i - 1) = Range(levelCol & i).Value
If RawManager(i - 1) = "N/A" Then FncPopulateRawHierarchy = i - 1
Next i
End Function
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...
I have a VBA calculation that is looping to recalculate cells 500 (or whatever the iteration is) times. For each recalculation there is an output which I want a record of after the loop is complete. I have tried a few different ways but I can't seem to get it right. Here is an example of what I have so far.
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Iteration = Range("C4")
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
Range("C20").Copy
Range("J" & Rows.Count).End(xlUp).Offset(1).Select.PasteSpecial xlPasteValues
Next i
End Sub
I think the only problem is that you are selecting in the same line as pasting special. Try this:
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Iteration = Range("C4")
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
Range("C20").Copy
Range("J" & Rows.Count).End(xlUp).Offset(1,0).PasteSpecial Paste:=xlPasteValues
Next i
End Sub
Try this:
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Dim val as Variant
Iteration = Range("C4")
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
val = Range("C20").Value
Debug.print "i: " & i & " val: " & val
Range("J" & Rows.Count).End(xlUp).Offset(1) = val
Next i
End Sub
If the correct values do not show up in the immediate window, the problem lies elsewhere. Obviously, delete the debug.print statement, if the code works as expected.
Private Sub CommandButton1_Click()
Dim Iteration As Integer, i As Integer
Iteration = Range("C4")
Dim RLog As Range ' prepare a range for the log
Set RLog = [C22] ' or wherever you want to start the log range
For i = 1 To Iteration
Range("C14,C15,C16,C17,C18,C19,C20").Calculate
RLog(i,1) = [C20] ' write the current result to the range (short notation [C20] is aequivalent to Range("R20")
Next i
End Sub
I am trying to create a named range that refers to all cells containing formulas or constants. But I get an error message on the row that starts with Set r = Union(...
How can I get this to work?
Dim r As Range
Set r = Union(Sheet1.Cells.SpecialCells(xlCellTypeConstants), Sheet1.Cells.SpecialCells(xlCellTypeFormulas), _
Sheet22.Cells.SpecialCells(xlCellTypeConstants), Sheet22.Cells.SpecialCells(xlCellTypeFormulas))
Union only works with Ranges that are on the same sheets. You can build a collection of the addresses like this though
Sub Main()
Dim arr As Variant
arr = Array( _
GetAddresses(Sheet1, xlCellTypeConstants), _
GetAddresses(Sheet1, xlCellTypeFormulas), _
GetAddresses(Sheet2, xlCellTypeConstants), _
GetAddresses(Sheet2, xlCellTypeFormulas) _
)
Dim r As Variant
For Each r In arr
If Len(r) > 0 Then Debug.Print r
Next
End Sub
Function GetAddresses(sh As Worksheet, cellType As XlCellType) As String
On Error Resume Next
GetAddresses = sh.Name & "!" & sh.Cells.SpecialCells(cellType).Address
On Error GoTo 0
End Function
If you need to handle your errors differently, have a look at this answer