I have this code:
Sub yeartest()
Dim cell As Range
storeval = 0
For Each cell In Range("I7:I17")
If cell.Value = "THISVALUE" Then
Let storeval = cell.Offset(-1, 0).Value
End If
Range("Q18").Activate
ActiveCell.Formula = "=SUM(storeval)"
Next cell
End Sub
What the code should do is analyze the range I7:I17. Everytime it encounters a cell in this range with the value THISVALUE it should go right by one cell and store that value. After the entire range has been analyzed the sum of all cells one right of THISVALUE should be output in cell Q18.
Currently cell Q18 just displays a #NONAME value when I execute the macro.
Sub yeartest()
Dim cll As Range
storeval = 0
For Each cll In Range("I7:I17")
If cell.Value = "THISVALUE" Then
storeval = storeval + cell.Offset(-1, 0).Value
End If
Next cll
Range("Q18")=storeval
End Sub
Related
I have data on Worksheets("North").Range("B3:B500") , and data on Worksheets("Auto").Range("A2:A22") in the same workbook.
How to check If every Cell in first Range found on the second Range, and if it exists, some code will run (Offset )?
The problem on the below code in this line:
If Cell.value = Worksheets("Auto").Range("A2:A22") Then
Sub Check_Range()
Dim WorkOrder As Range
Dim Closed_Data As Range
Dim Cell As Object
Set WorkOrder = Worksheets("North").Range("B3:B500")
Set Closed_Data = Worksheets("Auto").Range("A2:A22")
For Each Cell In WorkOrder
If Cell.value = Worksheets("Auto").Range("A2:A22") Then
Cell.Offset(, 6).value = "Close"
Cell.Offset(, 7).value = Now
End If
Next Cell
End Sub
It is not possible to compare the value of one cell to a range. Try this code:
Sub Check_Range()
Dim WorkOrder As Range
Dim Closed_Data As Range
Dim Cell As Object
Set WorkOrder = Worksheets("North").Range("B3:B500")
Set Closed_Data = Worksheets("Auto").Range("A2:A22")
On Error Resume Next
For Each Cell In WorkOrder
With Cell
WorksheetFunction.Match .Value, Closed_Data, 0 'value search
If Err.Number = 0 Then ' if there is no error, then the value was found
.Offset(, 6).Value = "Close"
.Offset(, 7).Value = Now
End If
Err.Clear
End With
Next Cell
On Error GoTo 0
End Sub
I am looping through a range of cells to check if a value is 0. My logic is if cell value is zero, then cell value is the previous cells value. If that previous cell is also zero, then it is the next cell's value. But I said what if the last cell or first cell is zero? I need to check that too because if it is the first cell or last, then the loop fails. My question is, what should the code be to pass through the last row as an address. I know the last row, but I do not know how to write it as an address with a known column. The data starts at row 2 and then goes to row X.
For each Cell In rng
If Cell.Address="A2" Then
If Cell.Value=0 Then
Cell.Value=Cell.Offset(1,0).Value
End if
Elseif Cell.Address="AX" Then 'X is the last row
If Cell.Value=0 Then
Cell.Value=Cell.Offset(-1,0).Value
End If
Elseif Cell.Value=0 and Cell.Offset(1,0).Value=0 Then
Cell.Value=Cell.Offset(-1,0).Value
Elseif Cell.Value=0 Then
Cell.Value=Cell.Offset(1,0).Value
Else
Do Nothing
End If
Next
I've added three rows to define the variables and range.
Other than that I've only made changes to the IF statement and the first ELSEIF statement.
Sub Test()
Dim rng As Range
Dim Cell As Range
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1:A20")
For Each Cell In rng
If Cell.Address = rng(1).Address Then
If Cell.Value = 0 Then
Cell.Value = Cell.Offset(1, 0).Value
End If
ElseIf Cell.Address = rng(rng.Cells.Count).Address Then
If Cell.Value = 0 Then
Cell.Value = Cell.Offset(-1, 0).Value
End If
ElseIf Cell.Value = 0 And Cell.Offset(1, 0).Value = 0 Then
Cell.Value = Cell.Offset(-1, 0).Value
ElseIf Cell.Value = 0 Then
Cell.Value = Cell.Offset(1, 0).Value
Else
'Do Nothing
End If
Next
End Sub
Edit: (after answer accepted).
To loop through each cell in each column you'll need a loop to look at each column and then another to look at each cell within the column.
In the code below I have defined col as a range.
This is then used in the first loop (For Each col in rng.Columns).
The second loop then looks at each cell within col (For Each Cell in col.Cells).
Sub Test()
Dim rng As Range
Dim Cell As Range
Dim col As Range
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1:Z20")
For Each col In rng.Columns
For Each Cell In col.Cells
If Cell.Address = rng(1).Address Then
If Cell.Value = 0 Then
Cell.Value = Cell.Offset(1, 0).Value
End If
ElseIf Cell.Address = rng(rng.Cells.Count).Address Then
If Cell.Value = 0 Then
Cell.Value = Cell.Offset(-1, 0).Value
End If
ElseIf Cell.Value = 0 And Cell.Offset(1, 0).Value = 0 Then
Cell.Value = Cell.Offset(-1, 0).Value
ElseIf Cell.Value = 0 Then
Cell.Value = Cell.Offset(1, 0).Value
Else
'Do Nothing
End If
Next
Next col
End Sub
Sorry I am a novice in VBA so any help is gratefully received!
I'm looking for some VBA code for a loop that will look at a range in Column A and as long as the cell in Column A is not 0, replace the adjacent cell in Column B with the positive value, looping through the range until all cells with data > 0 in Column A have been replaced in Column B. It is also important that blank cells in Column A do not overwrite positive data that may exist in Column B.
This is where I am at the moment:
Sub Verify()
Dim rng As Range
Dim i As Long
'Set the range in column N
Set rng = Range("N2:n1000")
For Each cell In rng
'test if cell = 0
If cell.Value <> 0 Then
'write value to adjacent cell
cell.Offset(0, -2).Value = *'What do I need here to find the first item of data e.g. N2 in column N?'*
End If
Next
End Sub
Many thanks
I think it would be easier to deal with ActiveSheet.Cells as with Range object and offsets :
Sub Verify()
Dim row As Long
For row = 2 To 1000
If ActiveSheet.Cells(row,1) <> "" Then ' Not blank
If ActiveSheet.Cells(row,1) > 0 Then ' Positive
ActiveSheet.Cells(row,2) = ActiveSheet.Cells(row,1)
End If
End If
Next
End Sub
This is the edit to what you started. I made the range dynamic, because I don't like making excel loop longer than it has to. That's my personal preference. The first block of code will copy over anything that isn't 0 or blank, and any negative numbers will be represented by their positive counterpart. That's at least how I understood your question.
Also, this code looks at data in Col N (like you have in your code) and copies the data to Col L. If you want A to B then simply change rng to = ws.Range("A2", ws.Cells(ws.Rows.Count, "A").End(xlUp)) and the myCell.Offset() to (0, 1).
Sub Verify()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Sheets(1) 'good form to always define the sheet you're working on
Set rng = ws.Range("N2", ws.Cells(ws.Rows.Count, "N").End(xlUp)) 'dynamic range
For Each myCell In rng
If myCell.Value <> "" And myCell.Value <> 0 Then 'If the cell isn't 0 or ""
If myCell.Value < 0 Then 'Then if it's negative, make it positive and copy it over
myCell.Offset(0, -2).Value = myCell.Value * -1
Else: myCell.Offset(0, -2).Value = myCell.Value 'otherwise copy the value over
End If
End If
Next myCell
End Sub
If you only want to copy over values that are greater than 0, and ignore 0's, blanks, and negative values, then use this code:
Sub Verify()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Sheets(1) 'good form to always define the sheet you're working on
Set rng = ws.Range("N2", ws.Cells(ws.Rows.Count, "N").End(xlUp)) 'dynamic range
For Each myCell In rng
If myCell.Value <> "" And myCell.Value > 0 Then 'If the cell is > 0 and not ""
myCell.Offset(0, -2).Value = myCell.Value 'copy the value over
End If
Next myCell
End Sub
If I understand your question correctly, you can "simplify" it to something like this:
Sub Verify()
[b2:b1000] = [if(iferror(-a2:a1000,),abs(a2:a1000),b2:b1000&"")]
End Sub
just replace a2:a1000 with your Column A range and b2:b1000 with the Column B range.
Private Sub CommandButton1_Click()
Dim rng As Range
Dim cell As Variant
Set rng = Range("C8:C12")
For Each cell In rng
Sheets("Sheet1").Range("A1:H7").Copy Destination:=Sheets("Quantity").Range("XFD4").End(xlToLeft).Offset(-3, 3)
Sheets("Quantity").Range("XFD1").End(xlToLeft).Offset(0, 1).Value = cell.Offset(1, -1).End(xlUp).Value
Sheets("Quantity").Range("XFD2").End(xlToLeft).Offset(0, 1).Value = cell.Value
Sheets("Quantity").Range("XFD3").End(xlToLeft).Offset(0, 1).Value = cell.Offset(0, 1).Value
Next
End Sub
What I want to accomplish here is to skip blank cell/row. Because it will copy empty data to the sheet. Is there any method e.g. Not isEmpty or isBlank for this For loop? Thanks in advance.
You should be able to check IsEmpty(cell) to see if a cell is empty.
For example (untested):
For Each cell In rng
If Not IsEmpty(cell) Then
Sheets("Sheet1").Range("A1:H7").Copy Destination:=Sheets("Quantity").Range("XFD4").End(xlToLeft).Offset(-3, 3)
Sheets("Quantity").Range("XFD1").End(xlToLeft).Offset(0, 1).Value = cell.Offset(1, -1).End(xlUp).Value
Sheets("Quantity").Range("XFD2").End(xlToLeft).Offset(0, 1).Value = cell.Value
Sheets("Quantity").Range("XFD3").End(xlToLeft).Offset(0, 1).Value = cell.Offset(0, 1).Value
End If
Next
How can I create a macro that will add a day in one cell and subtract a day in another cell at the same time? Here is what I have so far.
Sub ChangeDates()
Dim cell As Range
For Each cell In Range("B:B")
cell.Value = cell.Value + 1
Next cell
For Each cell In Range("C:C")
cell.Value = cell.Value - 1
End Sub
I know you've accepted an answer, but I would like to offer this approach, which is even faster and more efficient than looping through all those cells.
If your dates are in Column A, then Column B will hold date +1 and Column C will hold date -1
Option Explicit
Sub ChangeDates()
Dim myRange As range
Dim mySheet As Worksheet
Set mySheet = Sheets("Sheet7") 'change to your sheet
With mySheet
Set myRange = .range("A1:A" & .range("A" & .Rows.Count).End(xlUp).Row)
myRange.Offset(, 1).FormulaR1C1 = "=RC[-1]+1"
myRange.Offset(, 2).FormulaR1C1 = "=RC[-2]-1"
End With
End Sub
Offset to the rescue!!
Sub ChangeDates()
Dim cell As Range
For Each cell In Range("B:B")
cell.Value = cell.Value + 1
cell.offset(0,1).value = cell.offset(0,1).value - 1
Next cell
End Sub
Another thing you may consider is either looking at usedrange to not have to iterate through all of column B or put in a check to make sure the cells aren't blank... Just faster, better coding and stops you from having bad values where the cells were originally blank...
Sub ChangeDates()
Dim cell As Range
For Each cell In Intersect(Range("B:B"), ActiveSheet.UsedRange)
cell.Value = cell.Value + 1
cell.Offset(0, 1).Value = cell.Offset(0, 1).Value - 1
Next cell
End Sub