Add cell one + cell two and reset cell two to zero - vba

I hope my Intention is clear. It's for inventory management. The first cell Shows the current inventory and the second one is just a cell where you can type in your entries or outflow. I think the Code for Excel should be something like this, but I'm looking for the corresponding Google spreadsheet:
Sub LagerNeu()
Dim S As Integer
[F2].Select
S = ActiveCell.Value + ActiveCell.Offset(0, 1).Value
ActiveCell.Value = S
ActiveCell.Offset(0, 1).Value = 0
End Sub

Using the onEdit() method can watch for changes to the F column and update the cells as needed
Example:
function onEdit(e) {
var range = e.range; // e.g F2 is edited
// Only runs if the edit is in column F
if (range.getColumn() == 6) {
var old_value = range.offset(0, -1).getValue();
// Set the new value to the cell in the column to the left - E2
range.offset(0, -1).setValue(Number(old_value) + Number(e.value));
// Reset F2 to zero
range.setValue(0);
}
}

Related

How can I refer to a data in a different row?

I've got an Excel file with N rows and M columns. Usually data are organized one per row, but it can happens that a data occupy more than a row. In this case how can I express that the second (or next) row has to refer to the first row?
In this example, AP.01 has got 5 rows of description, so how can I say that the other 4 rows refer also to the first code?
EDIT once that I did the association I have to export my Excel file into an Access DB. So I want to see the tables with the correct data.
If I have only one row for the description I wrote this code and it works:
If grid(r, 3).Text.Length > 255 Then
code.Description = grid(r, 3).Text.ToString.Substring(0, 252) + "..."
Else
code.Description = grid(r, 3).Text.ToString
End If
Instead if I have more than one row for the description I wrote this code and it doesn't work:
Do While grid(r, 1).ToString = ""
If grid(r, 1).ToString = "" And grid(r, 3).ToString IsNot Nothing Then
Dim s As String
s = grid(r, 3).ToString
code.Description = grid((r - 1), 3).ToString & s
End If
Loop
If it is a one-off, try the below. This will basically put a formula in every cell that refers to the cell immediately above it:
Select column A (from top until bottom of list (row N)
Press ctrl + g to open the GoTo dialogue
Press Special
Select Blanks from the radio buttons
The above will select all the blank cells in column A. Now enter = and press up arrow. Enter the formula by holding down ctrl while pressing enter. That will enter the same formula in every cell.
Try
Sub Demo()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet3") 'change Sheet3 to your data sheet
With .Range("A:A").SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
End Sub
From your question I Guess that, you must be define a variable for last column Value. and check the value in respective column, if it is empty then use column value if not empty then take current value as last value.
'Dim LastValue as string
LastValue = sheet("SheetName").cells(i,"Column Name").value
for i = 2 to LastRow '>>>> here i am assume you run code in for loop from row to
'to last count row(LastRow as variable)
'Put your sheet name at "SheetName" and column index (like "A","B","C"...) at "Column Name"
if sheet("SheetName").cells(i,"Column Name").value <>"" then
LastValue = sheet("SheetName").cells(i,"Column Name").value
end if
'(Do your stuff using LastValue , you may generate lastvalue 1, lastvalue2 ..etc)
next'for loop end here

Writing a loop in Excel for Visual Basic

How do i write the following code as a loop. I want to copy values from a table in sheet 4 in a row from range (b:17:L17"). is there a more efficient way to do it with loops ?
ActiveSheet.Range("B17").Value = Sheets(4).Range("G8")
ActiveSheet.Range("C17").Value = Sheets(4).Range("G9")
ActiveSheet.Range("D17").Value = Sheets(4).Range("G10")
ActiveSheet.Range("E17").Value = Sheets(4).Range("G11")
ActiveSheet.Range("F17").Value = Sheets(4).Range("G12")
ActiveSheet.Range("G17").Value = Sheets(4).Range("G13")
ActiveSheet.Range("H17").Value = Sheets(4).Range("G14")
ActiveSheet.Range("I17").Value = Sheets(4).Range("G15")
ActiveSheet.Range("J17").Value = Sheets(4).Range("G16")
ActiveSheet.Range("K17").Value = Sheets(4).Range("G17")
ActiveSheet.Range("L17").Value = Sheets(4).Range("G18")
Yes, there is:
ActiveSheet.Range("B17:L17").Value = Application.Transpose(Sheets(4).Range("G8:G18").Value)
You can, using something like this (VB.Net, but may copy easily to VBA):
Dim cell as Integer, c as Integer
cell = 8
For c = 66 To 76
ActiveSheet.Range(Chr(c) & "17").Value = Sheets(4).Range("G" & cell)
cell = cell + 1
Next
The Chr() function gets the character associated with the character code (66-76), and then this value is concatenated with the string "17" to form a complete cell name ("B17", "C17", ...)
I am also incrementing the cell number for G at the same time.
Use this if you really want to use a loop - but there could be better ways, like the answer given by #A.S.H
Solution explanation:
Establish your rules! What is changing in the range for active sheet? The column is going to grow as the for/to cycle does! So, we should sum that to it. What is the another thing that is going to increment? The Range in the other side of the '=' so, by setting an algorithm, we may say that the row is const in the Activesheet range and the column is the on variable on the other side.
Solution:
Sub Test()
Const TotalInteractions As Long = 11
Dim CounterInteractions As Long
For CounterInteractions = 1 To TotalInteractions
'where 1 is column A so when it starts the cycle would be B,C and so on
'where 7 is the row to start so when it begins it would became 8,9 and so on for column G
ActiveSheet.Cells(17, 1 + CounterInteractions).Value = Sheets(4).Cells(7 + CounterInteractions, 7)
Next CounterInteractions
End Sub
This is probably your most efficient solution in a with statement:
Sub LoopExample()
Sheets("Sheet4").Range("G8:G18").Copy
Sheets("Sheet2").Range("B17").PasteSpecial xlPasteValues, Transpose:=True
End Sub

I have 3 excel formulas that I would like to fill ranges in a spreadsheet with, how can I make sure the cells change with the rows?

=IF(AND(G2<>100,TODAY()>=H2, TODAY()<=I2), E2, " ")
=IF(N2=" ", " ",NETWORKDAYS(H2,TODAY()))
=IF(OR(O2 = " ", O2 <= 0), " ", (O2/N2)*100)
These are the three formulas, I want to make sure that as they are inserted into the worksheet the cell references will still change to match the rows they are on, as they would in a normal spreadsheet. Any advice would be much appreciated! (To clarify, I need to fill the ranges using VBA as the code I'm using clears the worksheet every time it is run.)
you could use FormulaR1C1 property of range object, which uses the "R1C1" notation for range addresses
for instance inserting your first formula in "A1" would be:
Range("A1").FormulaR1C1 = "=IF(AND(RC7<>100,TODAY()>=RC8, TODAY()<=RC9), RC5, "" "")"
where the pure R would assume the current cell row index, while C7 stands for a fixed (not varying with host cell position) 7th column index reference, and so on
If i have interpreted your question correctly, you need something like the below:
Option Explicit
Sub InsertFormula()
Dim i As Long
Dim n As Long
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To n
Cells(i, 1).Formula = "=IF(AND(G2<>100,TODAY()>=H2, TODAY()<=I2), E2, "" "")"
Next i
End Sub
replace the 1 in n=... with whichever column has the most rows of data
replace for i = 1 to whichever row it must begin form
You will notice i have added extra quotations to the end of the formula, this is needed as quotes in a formula in VBA must be enclosed... in more quotes lol
Apply this concept for the other formulas :)
Instead of absolute references like G2 you can use something along
.FormulaR1C1 = "=SUM(RC[-2]:R[5]C[-2])"
where R and C reference the offset from the current cell (positive: right or down, negative: up or left).
Use it in a way similar to this:
Dim c
For Each c In Selection
c.FormulaR1C1 = "=SUM(RC[-2]:R[5]C[-2])"
Next c
Relative References are adjusted when you set the formula to range of cells:
[A1:B2].Formula = "=C$1" ' now the formula in B2 will become "=D$1"
You can also set multiple formulas at once:
Range("K2:M9").Formula = Array("=IF(AND(G2<>100,TODAY()>=H2, TODAY()<=I2), E2, "" "")", _
"=IF(N2="" "", "" "",NETWORKDAYS(H2,TODAY()))", _
"=IF(OR(O2 = "" "", O2 <= 0), "" "", (O2/N2)*100)" )
or if each row has different formula:
[A1:Z3] = [{"=1";"=2";"=3"}]

Copy relative formula in excel with VBA

I'm trying to copy formulas with relative row and column names.
I have base column with 10 formulas and I'm trying to copy formula 5 times on columns on the right.
So for example in base column i have this formula
=A1+B1 and i want to make next cell this =B1+C1 next =C1+D1 and so on.
I have this code
For i = 1 To Range("B1").Value
For j = 1 To 10
Sheet2.Cells(5 + j, 2 + i).FormulaR1C1 = "=c[-1]"
Next j
Next i
But this just copies value from left cell
It would be easy if the formulas were same but they are different. So im trying to find a way to dynamically reference always left cell.
This is one of the real formulas
='Balance sheet'!B13*360/'P&L'!B2
I want next cell to be
='Balance sheet'!C13*360/'P&L'!C2
And with code i have now next cell is =B3
If you want to copy a formula to right, that can be done with a fill operation. So with your formula in a cell defined by your base row and base column, and with it using relative addressing as in your question, merely:
Option Explicit
Sub foo()
Const lBaseColumn As Long = 3
Const lBaseRow As Long = 6
Const lRpts As Long = 10
Cells(lBaseRow, lBaseColumn).Resize(columnsize:=lRpts).FillRight
End Sub
You should note that you can FillRight from multiple rows at once, if that is what you need to do. The below would fill C6:C10 through to L6:L10
Option Explicit
Sub foo()
Const lBaseColumn As Long = 3
Const lBaseRow As Long = 6
Const lColRpts As Long = 10
Const lRows As Long = 5
Cells(lBaseRow, lBaseColumn).Resize(rowsize:=lRows, columnsize:=lColRpts).FillRight
End Sub
these two lines will copy formula / contents from left cell and copy in the reference cell. this will also copy the formula with relative reference
Range(refCellID).Offset(0,-1).Copy
Range(refCellID).PasteSpecial

VBA Conditional format cell based on whether value is in list of text

I have this code:
Sub Japan()
Set MyPlage = Range("A1:R1000")
For Each Cell In MyPlage
If Cell.Value = "A" Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
If Cell.Value = "B" Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
If Cell.Value = "C" Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
If Cell.Value = "D" Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
If Cell.Value = "E" Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
Next
End Sub
THis find any cells that have either A, B, C, D, E as the value and then colours the entire row red if so.
Basically, I have hundreds of more values that I want to lookup. I have them stored in another excel file (could just as easily be in a text file). How could I reference them? i.e, if cell value is in this list of text, do this.
Sounds like you want a Set datastructure that contains unique values and you can use an Exist method on it.
For example your desired usage is this.
Set MySet = LoadRedValueSet(???) ' explain later
Set MyPlage = Range("A1:R1000")
For Each Cell In MyPlage
If MySet.Exists(Cell.Value) Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
Next
Well too bad Set is a reserved keyword and VBA does not provide a Set object. However, it does provide a Dictionary object which can be abused like a Set would be. You will need to reference the Scripting Runtime Library to use it first through. The usage would be exactly as stated as above. But first we need to define LoadRedValueSet()
Lets assume that you are able to load whatever file you save these values as in as an Excel worksheet. I will not be explaining how to open various file types in Excel as there are many answers detailing that in more detail than I can. But once you have your range of values to add to the set we can add them to the dictionary.
Private Function LoadRedValueSet(valueRange As Range) As Dictionary
Dim result As New Dictionary
Dim cell As Range
For Each cell In valueRange.Cells
result(cell.value) = Nothing
Next cell
Set LoadRedValueSet = result
End Function
Dictionary are mapping objects that have key->value pairs. The key's are effectively a set, which is what we want. We don't care about the values and you can pass whatever you want to it. I used Nothing. If you use the .Add method the dictionary will throw an error if your list contains duplicate entries.
Assuming you have implemented some function that loads your file as a worksheet and returns that worksheet.
Dim valueSheet As Worksheet
Set valueSheet = LoadSomeFileTypeAsWorksheet("some file path")
Dim valueRange As Range
Set valueRange = valueSheet.??? 'column A or whatever
Dim MyDictAsSet As Dictionary
Set MyDictAsSet = LoadRedValueSet(valueRange)
Set MyPlage = Range("A1:R1000")
For Each Cell In MyPlage
If MyDictAsSet.Exists(Cell.Value) Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
Next
There are quite a few ways you could possibly do this but here's my approach. Application.WorksheetFunction.<function name> can be used to evaluate worksheet functions within VBA. This means we can use it to run a Match function. For the sake of a simple example let's assume your values to match are in Column A of a worksheet called Sheet2 (in the same workbook).
Dim MyPlage As Range, Cell As Range
Dim result as Variant
Set MyPlage = Range("A1:R1000") '<~~ NOTE: Sheets("<SheetName>").Range("A1:R1000") would be better
For Each Cell in MyPlage
result = Application.WorksheetFunction.Match(Cell.Value, Sheets("Sheet2").Range("A:A"), 0)
If Not IsError(result) Then
Rows(Cell.Row).Interior.ColorIndex = 3
End If
Next Cell
We only need to know whether or not the WorksheetFunction.Match function returned an error: If it didn't then Cell.Value was present in Column A of Sheet2 and we color the row red.
Paste your color value + index data to a new sheet called "Colors" in the following order;
Value ColorIndex
A 1
B 2
C 3
D 4
E 5
And update your method with the following code and update the range based your data;
Sub SetColors()
' DataCells: The cells that's going to be checked against the color values
Set DataCells = Range("A1:A15") ' Update this value according to your data cell range
' ColorValueCells: The cells that contain the values to be colored
Set ColorValueCells = Sheets("Colors").Range("A2:A6") ' Update this value according to your color value + index range
' Loop through data cells
For Each DataCell In DataCells
' Loop through color value cells
For Each ColorValueCell In ColorValueCells
' Search for a match
If DataCell.Value = ColorValueCell.Value Then
' If there is a match, find the color index
Set ColorIndexCell = Sheets("Colors").Range("B" & ColorValueCell.Row)
' Set data cell's background color with the color index
DataCell.Interior.ColorIndex = ColorIndexCell.Value
End If
Next
Next
End Sub