To start with I'm not really a wise man. So I was trying to add up two values and display them in a third (that's easy) but I also wanted it to repeat an infinite amount of times (namely that it does the same for every row, let's say I place the result in I5, I want also, on every I under it (I6, I7, I8, etc...)
Should it be:
Private Sub Worksheet_Change()
if IsNumeric(Range("B1").sort) And IsNumeric(Range("B2").sort) then
Dim value1 As Single
Dim value2 As Single
range(I5).sort = value+1 + value2
End Sub
Or as I think I'm horribly mistaken?
You're using the .Sort property of Range where you should be using .Value.
There's a couple of ways to achieve what you're looking to do. First option is to iterate through the range and add the relevant value to each cell like so:
Public Sub addCells()
Dim rng As Range, cell As Range
'Set the sheet name
With ThisWorkbook.Worksheets("Sheet_Name")
'Set the range below:
Set rng = .Range("I1:I10")
'Loop through range and add cells together
For Each cell In rng
cell.Value = cell.Offset(0, 2) + cell.Offset(0, 1)
Next cell
End Sub
Another way to do it if the values to be added is ordered in for example column A and B would be:
Public Sub addCells()
Dim rng As Range, cell As Range
'Set the sheet name
With ThisWorkbook.Worksheets("Sheet1")
'Add the first formula to the sheet
.Range("C1").Value = "=SUM(A1+B1)"
'Change the range below to the range to be filled
.Range("C1").AutoFill Destination:=.Range("C1:C10")
End With
End Sub
Related
I would like to be able to Check for criteria "owners" In column A and SUM cell from the same row column E with the cell above and repeat through the spread sheet where owner is found.
I have tried to use Function =SUMIF(A3,"*owner*",E2:E3) This returns the Value above the cell in the row with owner but does not SUM them.
I have also tried this VBA CODE and it does the same thing.
Sub vba_sumif()
Dim gRange As Range
Dim sRange As Range
Set gRange = Range("A3")
Set sRange = Range("E2:E3")
Range("G2") = _
WorksheetFunction.SumIf(gRange,"*Owner*", sRange)
End Sub
Ideally it would return the summed cells in the above cell. using VBA
Thanks again,
Aaron
Well first of all, I would suggest just using the formula unless you have a reason not to:
Formula:: Your first error with the formula is both ranges need to be the same size.
VBA:: Same thing here with range sizes, then you also need to remember to make sure Excel knows what sheet you're referring to. I like to do this with a With My_Worksheet_Namestatement, then include a . before any range from that sheet. Just make sure to change the sheet name to your sheet name
Option Explicit
Sub vba_sumif()
Dim TableSheet As Worksheet
Dim gRange As Range
Dim sRange As Range
Set TableSheet = Worksheets("TableSheet")
With TableSheet
Set gRange = .Range("A2:A13")
Set sRange = .Range("E2:E13")
.Range("G2").Value = _
WorksheetFunction.SumIf(gRange, "*Owner*", sRange)
End With
End Sub
I use Excel tables a lot. It makes it possible to have multiple tables in one worksheet. But I have got into a problem in VBA which I do not know how to solve.
Let us say that I have a table called "tbl" in my spreadsheet. It contains the following data:
id value
1 1000
1 2000
2 3000
2 4000
I have the following code which works:
Sub test()
Dim rng As Range
Dim arr() As Variant
Set rng = ActiveSheet.ListObjects("tbl").DataBodyRange
arr = rng.Value
End Sub
This code will put the whole table into arr. But there are situations where I only want some rows in the table. Let us say that I want row 4 and 5 i.e:
2 3000
2 4000
The following code will do the trick:
arr = Range("A4:B5")
But there are cases where I have many tables located in different places in my spreadsheet. Therefore I need to work out where the first cell in the table is located (upper left). If it is located in K1, I need to get both the column and the row (K and 1).
Is there an easy way to do this?
Use Cells():
Sub test()
Dim rng As Range
Dim arr() As Variant
Set rng = ActiveSheet.ListObjects("tbl").DataBodyRange
arr = ActiveSheet.Range(rng.Cells(3, 1), rng.Cells(4, 2)).Value
End Sub
If you just want the third and fourth data rows (i.e. fourth and fifth rows if you count the heading row), you could use
Sub test()
Dim rng As Range
Dim arr() As Variant
Set rng = ActiveSheet.ListObjects("tbl").DataBodyRange
arr = rng.Rows("3:4").Value
'or
arr = rng.Range("A3:B4").Value
End Sub
Because the Rows and Range properties are being applied to the rng object, the references ("3:4" and "A3:B4") are relative to the start of the rng object.
So you could also get the worksheet address of the first cell in rng by using rng.Range("A1").Address (or rng.Cells(1, 1).Address), or you can get the first cell's worksheet row and column by just using rng.Row and rng.Column respectively (they both default to returning the value for the first cell).
The first cell in a table has some unique properties:
-It is not empty
-The cell above it is null
-The cell to the left of it is null
-The cell below it is not null
Using these properties you can do something like:
1) Loop over every cell
2) If that cell has the above properties, then it is a "top left" cell
3) Do whatever with that table
So I have a big excel sheet with a bunch of empty cells in various locations. I want an easy to work with list of which cells are empty. I was hoping to make a new worksheet that was populated with the locations of the empty cells. I wanted to have this to just populate the cells I want it to. I kept the header from the worksheet I will be checking and added a blank cells count, so I want the following cells in the column to be populated by the list of empty cell locations.
Now I know I can use =ISBLANK to test if a cell is empty or not, but I only care about the cells that return TRUE. So I figure I'll need a loop. And I want the location of the cell so I can use =CELL. And to make this most readable I want to do this on a column by column basis.
But I want to populate a spreadsheet with this information in a manner similar to how functions work (I just want to copy and paste it to other cells and columns). But it's pretty clear that I am going to need VBA.
My question is how can I create a macro to populate my spreadsheet with a list of empty cells? How do I apply it to the cells?
I assume you have data in sheet1, I have used sample range// Range("A1:c15") however you can define range as per need and blank cells address will be published in next sheet.
Sub FindBlank()
Dim rng As Range
dim i as long
For Each rng In Sheet1.Range("A1:c15").SpecialCells(xlCellTypeBlanks)
i = i + 1
Sheet2.Cells(i, 1) = rng.Address
Next
End Sub
If you want a list of the cells that are empty, you can use Range().SpecialCells(xlCellTypeBlank):
Sub getEmptyCellAddresses()
Dim rng As Range
Dim ws as Worksheet
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15").SpecialCells(xlCellTypeBlanks) ' Edit/change range as necessary
ws.Cells(1, 2).Value = rng.Cells.Address ' Change `ws.cells(1, 2)` to whatever destination you like
End Sub
Edit: Ah, beaten by 16 seconds by #RamAnuragi ...but anyways, they're slightly different ways to tackle the question so I'll leave it.
Edit: For funsies, here's another way to put them all in a column, one row per cell...and more, per your comments.
Sub listEmptyCells()
Dim emptyAddresses() As String
Dim i As Long
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("Sheet1") ' CHANGE AS NECESSARY
Set rng = ws.Range("A1:A15")
If WorksheetFunction.CountBlank(rng) = 0 Then
MsgBox ("No empty cells in the range")
Exit Sub
End If
emptyAddresses() = Split(rng.SpecialCells(xlCellTypeBlanks).Address, ",")
For i = LBound(emptyAddresses) To UBound(emptyAddresses)
ws.Cells(i + 1, 2).Value = emptyAddresses(i)
Next i
End Sub
I have values on Sheet 1 and I gave the background color using conditional formatting.
I want to copy only the color and paste it to the corresponding cell of sheet 2 without pasting the value.
Example if sheet 1 cell A1 has red color for specific value, transfer the color to sheet 2 A1.
I use two colors, red and white. Red is for higher value and white is for lower value.
Sub copycolor()
Dim intRow As Integer
Dim rngCopy As Range
Dim rngPaste As Range
For intRow = 1 To 20
Set rngCopy = Sheet1.Range("A" & intRow + 0)
Set rngPaste = Sheet2.Range("b" & intRow)
'Test to see if rows 500+ have a value
If rngCopy.Value <> "" Then
'Since it has a value, copy the value and color
rngPaste.Value = rngCopy.Value
rngPaste.Interior.Color = rngCopy.Interior.Color
End If
Next intRow
End Sub
rngPaste.Interior.Color = rngCopy.DisplayFormat.Interior.Color
Seems to work for me. Keep in mind that DisplayFormat is read-only and is not allowed to return value outside of the function it's used in. Also it is only available in Excel 2010 +
I was editing my answer to include the other stuff you mentioned and realized it was getting confusing to explain it all in separate chunks. Here's a recommended approach to achieve what you're saying.
Public Sub CopyColor()
Dim SourceSht As Worksheet
Dim TargetSht As Worksheet
Dim rngCopy As Range
Dim rngPaste As Range
Dim LastCopyRow As Long
Dim LastCopyColumn As Long
'Define what our source sheet and target sheet are
Set SourceSht = ThisWorkbook.Worksheets("Sheet1")
Set TargetSht = ThisWorkbook.Worksheets("Sheet2")
'Find our used space on the source sheet
LastCopyRow = SourceSht.Cells(Rows.Count, "A").End(xlUp).Row
LastCopyColumn = SourceSht.Cells(1, Columns.Count).End(xlToLeft).Column
'Setup our ranges so we can be sure we don't loop through unused space
Set rngCopy = SourceSht.Range("A1:" & SourceSht.Cells(LastCopyRow, LastCopyColumn).Address)
Set rngPaste = TargetSht.Range("A1:" & TargetSht.Cells(LastCopyRow, LastCopyColumn).Address)
'Loop through each row of each column.
' This will go through each cell in column 1, then move on to column 2
For Col = 1 To LastCopyColumn
For cel = 1 To LastCopyRow
' If the string value of our current cell is not empty.
If rngCopy.Cells(cel, Col).Value <> "" Then
'Copy the source cell displayed color and paste it in the target cell
rngPaste.Cells(cel, Col).Interior.Color = rngCopy.Cells(cel, Col).DisplayFormat.Interior.Color
End If
Next cel
Next Col
End Sub
Simplest would be to apply the same conditional formatting to Sheet2, but use the values from Sheet1 as your criteria. So if Sheet1 Cell A1 has the value that makes it red, add formatting to Sheet2 that turns Sheet2 Cell A1 red as well.
There's a good explanation of how to achieve this here.
.Interior.Color gets the actual colour of the cell rather than the conditionally formatted colour (the one you see). So you can't copy/paste this red colour in your example in this way.
I believe that the only way to get the conditionally formatted colour you see would be to recompute whatever formula you've used in your conditionally formatting criteria.
Excel 2007 conditional formatting - how to get cell color?
Edit
While #JeffK627 was giving an elegant solution, I was knocking up some rough vba code to recompute what I gather your conditional formatting does. I've done this over range A1:A20 on sheet 2. At the moment it colours the cell that contains the value itself, but only requires a little tweak to colour the equivalent cell on another sheet.
Sub ColouringIn()
Dim intColIndex As Integer
Dim dblMax As Double
Dim dblMin As Double
Dim rngCell As Range
'RGB(255, 255, 255) = white
'RGB(255, 0, 0) = red
'so need to extrapolate between
dblMax = Application.WorksheetFunction.Max(Sheet2.Range("A1:A20"))
dblMin = Application.WorksheetFunction.Min(Sheet2.Range("A1:A20"))
For Each rngCell In Sheet2.Range("A1:A20")
If IsNumeric(rngCell.Value) And rngCell.Value <> "" Then
intColIndex = (rngCell.Value - dblMin) / (dblMax - dblMin) * 255
rngCell.Interior.Color = RGB(255, intColIndex, intColIndex)
End If
Next rngCell
End Sub
Adding following example as alternative solution, as I needed something dynamic/active where color IS a required condition of data & not reliant on any other trigger.
Option1:
Dim rngPrev2Update As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cellbox As Range
Dim rngDest As Range
If Not rngPrev2Update Is Nothing Then
For Each cellbox In rngPrev2Update.Cells
Worksheets("Sheet2").Range(cellbox.Address).Interior.ColorIndex = cellbox.Interior.ColorIndex
Next cellbox
End If
Set rngPrev2Update = Target
End Sub
This will update destination cells when cursor is next moved to another cell.
Option2:
Private Sub Worksheet_Activate()
Dim cellbox As Range
Dim rngCells As Range
Set rngCells = Range("B1:B10")
For Each cellbox In rngCells.Cells
Range(cellbox.Address).Interior.ColorIndex = Worksheets("Sheet2").Range(cellbox.Address).Interior.ColorIndex
Next cellbox
End Sub
Will update relevant cells on sheet load.
Note: If you have very large data set you may want to put this into a macro button &/or filter this further for only the cells you need, otherwise this may slow your spreadsheet down.
Appreciating this was some time ago. I would like to do a similar thing however would like to append the Interior Color Reference ie. 255 to the cells value.
so if cell A1 has Hello in the cell and is Colored Red I'd want in the other worksheet cell A1: Hello | 255
Just used | as a delimiter but anything sensible...
I am using an Index/Match to get data from a related table to populate in the first table. In my related table I have filtered out values, but the filtered out values are still populating in my first table. If Index/Match is not smart enough to only grab the filtered values, how can I work around this (formula preferred, but VBA acceptable) to get only the filtered values.
Here is my current formula:
=INDEX(Table_owssvr__1[MyValues],MATCH([#[ID]],Table_owssvr__1[ID],0))
You might find the SUBTOTAL function useful, as it only works on visible rows. (Here's some more general discussion about SUBTOTAL)
But if that's not flexible enough for your needs, here's how to check whether a certain cell is filtered out or not.
Using this, I've written a bit of VBA code to sum over a column summing only visible cells. Should be a pretty useful start in doing whatever you need to do.
If summing over the cells is not what you want to do, just change the part indicated in the comments. (Obviously you'd have to change the name of the function from sumFilteredColumn to something else!)
Public Function sumFilteredColumn(startCell As Range)
Dim lastRow As Long ' the last row of the worksheet which startCell is on
Dim currentCell As Range
Dim runningTotal As Long ' keeps track of the sum so far
lastRow = lastRowOnSheet(startCell)
Set currentCell = startCell
' Loop until the last row of the worksheet
Do While currentCell.Row <= lastRow
' Check currentCell is not hidden
If Not cellIsOnHiddenRow(currentCell) Then
' -------------------------------------------------
' Here's where the magic happens. Change this to
' change sum to, e.g. concatenate or multiply etc.
If IsNumeric(currentCell.Value) Then
runningTotal = runningTotal + currentCell.Value
End If
' -------------------------------------------------
End If
Set currentCell = currentCell.Offset(1) ' Move current cell down
Loop
sumFilteredColumn = runningTotal
End Function
' return the number of the last row in the UsedRange
' of the sheet referenceRange appears in
Public Function lastRowOnSheet(referenceRange As Range) As Long
Dim referenceSheet As Worksheet
Dim referenceUsedRange As Range
Dim usedRangeCellCount As Long
Dim lastCell As Range
Set referenceSheet = referenceRange.Parent
Set referenceUsedRange = referenceSheet.usedRange
usedRangeCellCount = referenceUsedRange.Cells.CountLarge
Set lastCell = referenceUsedRange(usedRangeCellCount)
lastRowOnSheet = lastCell.Row
End Function
' Is the row which referenceCell is on hidden by a filter?
Public Function cellIsOnHiddenRow(referenceCell As Range) As Boolean
Dim referenceSheet As Worksheet
Dim rowNumber As Long
Set referenceSheet = referenceCell.Parent
rowNumber = referenceCell.Row
cellIsOnHiddenRow = referenceSheet.Rows(rowNumber).EntireRow.Hidden
End Function
LondonRob mentioned the SUBTOTAL function. AGGREGATE is a more general function than SUBTOTAL that operates with knowledge of both hidden and filtered cells (there is a difference). They'll do that without addins or VBA, though with somewhat hard-to-read formulae.
I learnt it from here.
I have been able to get this working by the following:
1) Create three worksheets, one for clients, one for purchases, and one for purchasesforclient.
2) Create a Macro to copy filtered values to a new worksheet:
Sub Purchases()
Dim Rng As Range
Set Rng = Worksheets("Comments").Columns("A")
Set Rng = Rng.Resize(65535, 1).Offset(1, 0)
Set Rng = Rng.Resize(, 5).SpecialCells(xlCellTypeVisible)
Rng.Copy Worksheets("PurchasesforClient").Range("A2")
End Sub
3) When I update the purchases via a filter, I run the macro in step 2 by creating a subtotal field and triggering the macro as follows. Since it is a formula, it requires a calculation to occur. This is embedded in the purchases sheet as VBA where the filtering is occurring, where B23 is the subtotal field that changes when it counts the amount of items once a filter is applied:
Public CurrentValue As Double
Private Sub Worksheet_Activate()
CurrentValue = Application.WorksheetFunction.Sum(ActiveSheet.Range("B23"))
End Sub
Private Sub Worksheet_Calculate()
If Application.WorksheetFunction.Sum(Range("B23")) <> CurrentValue Then Purchases
End Sub
4) I use the now filtered values in the purchasesforclient worksheet for my index/match formula in the clients worksheet. This allows me to dynamically filter by date, purchase type, etc. and have updated information in the clients worksheet
This answer requires MOREFUNC addon*
=INDEX(ARRAY.FILTER(Table_owssvr__1[MyValues]),MATCH([#[ID]],ARRAY.FILTER(Table_owssvr__1[ID]),0))
ARRAY.FILTER() function "Stores only the visible cells of a range (for instance a filtered range) in an array and returns this array. "
*MOREFUNC ADDON
Morefunc Addon is a free library of 66 new worksheet functions.
HERE is some information (by original author)
here is the last working download link I found
here is a good installation walk-through video