I need to find a way to sum these columns into the lower row. I'm using VBA for an exercise but I don't seem to get it without relying on referencing to each cell.
The result should be an array in which each item is the sum of the values of the table's column and then print the array into the range shown in the picture.
What happens if the number of rows in the column changes?
This is the code I have tried:
Sub cambios_combobox()
Dim librito As Worksheet
Dim celda As Range
Set librito = ActiveWorkbook.Sheets("Tabla Paquetes")
Set celda = Range("A40")
'Range("Table1[[#All],[Column1]]").Select
Select Case ComboBox1.Text
Case "Deco"
Range("eq_asis").Value = Application.Sum(librito.Range("Tabla2[Asistente fotografía]"))
Range("eq_asis").HorizontalAlignment = xlRight
...
It goes like that, referencing every single cell in that row, summing values up. I figure there must be another way to do that without so much waste.
The following code will put the totals formulas in that row. It first shows the totals row and then applies a formula in it that sums all visible cells in the current column starting at row 2 (R2C) and ending with the cell right above the sum (R[-1]C). Excel might convert this R1C1 notation to A1 notation when it transfers the formula to the cells. Obviously change Sheet2!R1C2 to whatever other cell you are subtracting from the sum.
Public Sub showTotalsMinusOtherCell()
Dim lst As ListObject
Dim ws As Worksheet
Set ws = ActiveSheet
Set lst = ws.ListObjects("Table1")
lst.ShowTotals = True
lst.TotalsRowRange.FormulaR1C1 = "=Subtotal(109,R2C:R[-1]C)-Sheet2!R1C1"
End Sub
Related
I have copied an Excel table to an array.
Sub
Dim Mentors As Variant
Mentors = Worksheets("Mentors").ListObjects("Mentors").DataBodyRange.Value
end sub
Now I would like to loop through the Mentors array to find rows with invalid values and delete those rows from the array, but I don't know how to do that.
Then I will put the array back in the table. (That I know how to do).
Deleting a row from an array is a pain, it would be easier to work directly on your table:
Dim tbl As ListObject
Dim x As Long
Set tbl = ActiveSheet.ListObjects("Mentors")
For x = tbl.ListRows.Count to 1 step -1
If your_delete_conditions_go_here Then
tbl.ListRows(x).Delete
End If
Next x
I have a named range which has been placed into an array; the array have 10 fixed columns, but any number of rows. The code to this point is:
Dim LD As Long
Dim Rng As Excel.Range
Dim vArray() As Variant
Dim varTOne() As Variant
Dim varTTwo() As Variant
Dim DSheet As Worksheet
Set DSheet = Worksheets("DataSheet")
LD = DSheet.Cells(Rows.count, "A").End(xlUp).row
Set Rng = ThisWorkbook.Worksheets("DataSheet").Range("A5:J" & LD)
vArray = Rng
Two of the columns, A and B say, are used to uniquely identify a certain result, which is in the last column (J). I need to first ensure that the result is indeed in the array (existence) and then extract the result. In order to ensure existence I would like to merge these two columns A and B, which will give me a "unique key" and match this key to a list. This would we quicker than a nested loop though Column A and B! What is the best way to go around this? I managed to split off the two columns like this:
varTOne = Application.Index(vArray, , 1)
varTTwo = Application.Index(vArray, , 2)
But some how cant get them to merge properly using any of How do I Merge two Arrays in VBA?
What am I doing wrong here?
Is it possible to merge two columns in an array without some timely loop?
I'm going to try to simplify this a bit because I don't have any code written for this portion of my macro. My macro takes data and copy pastes it multiple times depending on how many time periods I want. The next step is it takes the values in an array and pastes it in a column next to the data the same amount of times. I'm trying to figure out how to then paste formulas into the next column based on which value in the array is in that cell.
Columns A-Q (data) Column R (pasted values from array, 17 total integers) Column S (paste formulas based on value in column R). Note this data extends down between 150k-250k rows so something efficient is desired if possible. I feel like a loop would take years.
Would this just be a two dimensional array? or some sort of vlookup coded in vba? Just looking for a bump in the right direction here. Thanks.
If I understood you correctly, you have a data array (located in columns A-R), and column R is the only thing the formula in column S is directly dependent on.
This macro should do the trick. Assuming you don't plan to do anything computationally intensive to determine the formula, it will also be very fast. On my computer, these two as they are written written execute in 1-2 seconds on 1 million rows.
The macro assumes you will select the part of the data table you want to process. It is only important it includes your "column R" as the last column. It would be also easy to rewrite it so it always takes column R, and it figures out on its own how many rows they are, in case that's your desired behavior.
The macro:
Sub MyMacro()
Dim DataRange As Excel.Range
Dim InputRange As Excel.Range
Dim OutputRange As Excel.Range
Dim InputData() As Variant
Dim OutputData() As Variant
Dim RowNumber As Long
Dim ColumnNumber As Long
Dim i As Long
Set DataRange = Excel.Selection
RowNumber = DataRange.Rows.Count
ColumnNumber = DataRange.Columns.Count
'this sets the input as the last column in the data range and
'the output range exactly next to your array of inputs,
'regardless of whether it ends on column R, S, or wherever
Set InputRange = DataRange.Columns(ColumnNumber)
Set OutputRange = InputRange.Offset(0, 1)
'this stores the values from the input range into an array,
'and initializes the output array (it will be a 2D array - (Row, Column)
InputData = InputRange.Value
OutputData = OutputRange.Value
'you populate the value array inside VBA and only output to excel once -
'this is MUCH faster than interating through the cells directly
For i = 1 To RowNumber
OutputData(i, 1) = FunctionThatReturnsFormulasFromInputs(InputData(i, 1))
Next i
OutputRange.Formula = OutputData
End Sub
Example function:
Function FunctionThatReturnsFormulasFromInputs(InputValue As Variant) As String
Select Case InputValue
Case 1
FunctionThatReturnsFormulasFromInputs = "aaa"
Case Else
FunctionThatReturnsFormulasFromInputs = "bbb"
End Select
End Function
I will try to illustrate the scenario by only focus on the problem and take out all the non essential issues/scripts.
User selects multiple non-contiguous cells. VBA would do a few things...then insert a column.
If the selected cells happened to be at the right side of the columns, the content would move one column right of the original selected cells. I need to re-select the cells with the original content before exit sub.
For instance,
the user selects "A1", "C3", and "D4:E6".
the vba insert a column at "B"
now the content of "C3" and "D4:E6" move to "D3" and "E4:F6"
I need the vba to select "A1", "D3" and "E4:F6" before exit sub.
I have considered a few methods:
Offset the entire selection to one column right.
selection.offset(0,1).select
This is not a good solution as "A1" would move to "B1". It is only ok if the user selected cells are all at the right side of the inserted column.
Put each cell of selection (selected range) into array. Change the affected cells' range. and use vba to select them all again. The problem is that the vba I wrote can't select the entire array of ranges (multiple non contiguous cells) at once. It only selects the last cell in the array. Here is the summarized code:
Sub mtArea()
Dim Cell, Rg, sRg() As Range
Dim h, i, j, k, noCell, Cnt As Long
Set Rg = Selection
noCell = Rg.Cells.Count
k = 0
' assign each cell in selection to a specific array
If Rg.Areas.Count > 1 Then
ReDim sRg(noCell)
For Each Cell In Rg
k = k + 1
Set sRg(k) = Cell
Next Cell
End If
' select the new located cells
For i = 1 To noCell
If sRg(i).Column > 5 Then ' assuming insert column is "E"
h = 1
Else
h = 0
End If
sRg(i).Offset(0, h).Select
Next i
End Sub
In this case, only the last cell in the original range is being selected. Is there a way to select the entire sRg() range array?
I also hope to explore this way:
Dim Rg as Range
Set Rg = Selection
When user selects multiple non contiguous cells, is there a way for vba to change the individual cells range location in the Rg variable?
What should be the method?
Thank you.
If you assign a Name to the range, the cells will be adjusted after the column is inserted:
Sub RememberTheCells()
Range("A1,C3,D4:E6").Select
Selection.Name = "Previous"
Columns("B:B").Insert Shift:=xlToRight
Range("Previous").Select
MsgBox Selection.Address
End Sub
Try this
Sub InsertDemo()
InsertAndAdjustSelection 2
End Sub
Sub InsertAndAdjustSelection(Col As Long)
Dim strAddress() As String
Dim i As Long
' Save adresses of selected cells
strAddress = Split(Selection.Address, ",")
' Insert Column
Columns(Col).Insert
' Unpdate saved addresses
For i = 0 To UBound(strAddress)
If Range(strAddress(i)).Column >= Col Then
strAddress(i) = Range(strAddress(i)).Offset(, 1).Address
End If
Next
' Select range
Range(Join(strAddress, ",")).Select
End Sub
I have a horse show points spreadsheet where horses names and riders need to be matched up with the same pairs from other sheets. So, column 1 being the horse name, and column 2 being the rider name, I would like to display the point total from another sheet with the same horse/rider pair.
So, sheet1`row1 column 3 would need to find the same horse/rider pair (column a and b) from sheet 2 and display the point total (which is totaled in sheet2 column q of some row wherever that horse/rider pair is listed).
I'm not sure where to start with creating a formula like this. I did try with vlookup, but that doesn't seem to allow me to make an array of two columns and compare that with another array which I think is what I'm trying to do.
I think you may find the simplest solution (other than running a macro someone else has written for you of course) is to insert a column at the extreme left of both sheets and put something like =B2&" | "&C2 in Row2 of those columns (assumes your other columns have labels) then copy down and use a formula such as:
=IFERROR(VLOOKUP(A2,'Sheet 2'!A:R,18,FALSE),"")
(also in Row2 and copied down) to look up the points.
If you want to use VBA, you can insert a new module and copy this code in. Then you can use the function in a cell with =GetPointTotal(HorseCell, RiderCell)
Option Explicit
Function GetPointTotal(horseRange As Range, riderRange As Range)
Dim cell As Range, searchRange As Range
Dim displaySheet As Worksheet, pointSheet As Worksheet
Dim iEndRow As Integer
Dim horseCol As String, riderCol As String, pointCol As String, points As String
Dim b As Boolean
'Configuration
Set displaySheet = ThisWorkbook.Worksheets("Sheet1")
Set pointSheet = ThisWorkbook.Worksheets("Sheet2")
horseCol = "A"
riderCol = "B"
pointCol = "Q"
'EndConfiguration
iEndRow = pointSheet.Range(horseCol & 1).End(xlDown).Row
Set searchRange = pointSheet.Range(horseCol & 1 & ":" & horseCol & iEndRow)
b = False
For Each cell In searchRange
If b = True Then Exit For
If cell.Value2 = horseRange.Value2 Then
If cell.Offset(0, 1).Value2 = riderRange.Value2 Then
points = pointSheet.Range(pointCol & cell.Row).Value2
b = True
End If
End If
Next cell
GetPointTotal = points
End Function