The code should check if the cells in column E have a value of "J".
If so, paste the value "positiv" into the cell of column N of each respective line.
I tried several methods including range, cells and so on but I always get a runtime error.
With wsDURATION
Range("A1").Select
For x = 1 To wsDURLrow Step 1
If Cells.Offset(x, 4).Value = "J" Then
Cells.Offset(x, 13).Value = "positiv"
End If
Next x
End With
Ok guys, I have figured it out and the topic may be closed :)
With wsDURATION
For Each cell In rng.Cells
x = 0
If cell.Value = "J" Then
cell.Offset(x, 9).Value = "positiv"
End If
x = x + 1
Next
End With
Related
c specifies the columns I'm looping through and the Style is a highlight applied to blank cells. If the cell is blank I need the ID of that row (Cells(i,4)) to be copied to a reports page in the column c that I'm currently looping through. For readability I'm trying to copy each instance in the next available cell of that row but as you can imagine I'm getting an error at the Range(c & Rows.Count) portion of the code.
I'm aware that I can put A or any other column letter there but i'm just wondering if i were to be able to put the variable that I'm iterating with there instead. Any tips for this?
For c = 1 To 103
For i = 1 To coor(2)
If Cells(i, c).Style = "60% - Accent2" Then
Cells(i, 4).Copy Sheets("ReportsPage").Range(c & Rows.Count).End(xlUp).Offset(1, 0)
End If
Next i
Next c
Use Cells() instead of Range(). Cells() allows for the use of cardinal location:
For c = 1 To 103
For i = 1 To coor(2)
If Cells(i, c).Style = "60% - Accent2" Then
Cells(i, 4).Copy Sheets("ReportsPage").Cells(Rows.Count,c).End(xlUp).Offset(1, 0)
End If
Next i
Next c
One more note, one should always append any range object with their parent sheet, even if it is the activesheet:
With ActiveSheet
For c = 1 To 103
For i = 1 To coor(2)
If .Cells(i, c).Style = "60% - Accent2" Then
.Cells(i, 4).Copy Sheets("ReportsPage").Cells(Rows.Count,c).End(xlUp).Offset(1, 0)
End If
Next i
Next c
End With
You can use this to find the last column:
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
I am new to coding and am starting off on VBA. This isn't a homework assignment but a little project my dad challenged to me figure out. His instructions were:
Given an unspecified number of values in column A, determine if each value is less than OR is greater than or equal to 5. If the number is less than 5, print "Yes" in the cell next to it in column B. If the number is greater than or equal to 5, print "No". If the value in column A is not a numerical value or is blank, print "Non numeric entry".
Here is my problem: I can't seem to get the For loop to work with the nested If Statement. Do I need a counter? And what would I set as the range for the new entries in column B?
Here is my current code:
Sub practice()
Range (Cells(1,1), Cells(Rows.Count, 1). End(xlUp)).Select
For Each cell In Selection.Cells
If cell.value < 5 Then
ThisWorkbook.Sheets("Sheet3").Range().Value = "Yes"
Else cell.value >= 5 Then
ThisWorkbook.Sheets("Sheet3").Range().Value = "no"
End If
Next
End Sub
You should try to avoid using Select and Seletion, and use fully qualified Range instead. You can do this by fully qualify your Range with Worsheets("Sheet3").
You can use C.Offset(, 1).Value to modify the value in the cell to the right (Column B).
Try the code below:
Sub practice()
Dim Rng As Range
Dim C As Range
Set Rng = Worksheets("Sheet3").Range("A1:A" & Worksheets("Sheet3").Cells(Worksheets("Sheet3").Rows.Count, "A").End(xlUp).Row)
For Each C In Rng
If Not IsNumeric(C.Value) Or IsEmpty(C.Value) Then
C.Offset(, 1).Value = "Non numeric entry"
Else
If C.Value < 5 Then
C.Offset(, 1).Value = "Yes"
Else
If C.Value >= 5 Then
C.Offset(, 1).Value = "No"
End If
End If
End If
Next C
End Sub
I am trying to right code that will merge columns "D" through "L" when the number changes in column "M."
I have the following code, but all it does is merge every row from bottom up to row 2 regardless of value in column "M."
What am I missing???
Sub Merge_Upon_Change()
'Purpose: Merges cells between columns "D" and "L" when column "M" changes
Dim r As Long, i As Long
Application.DisplayAlerts = False 'Turn off windows warning popup
r = Cells(Rows.Count, "D").End(xlUp).row ' find last cell in Column D
For i = r To 2 Step -1
If Cells(i, 13).Value <> Cells(i + 13, 13).Value Then 'upon change in column M = 13
Range("D" & i & ":L" & i).Merge 'then merge column "D" through "L"
End If
Next i
Application.DisplayAlerts = True ''Turn on Windows warning popup
End Sub
Actually you have already made this question but to pretend this from being unanswered I am posting this answer for any future search about this question.
When you write your equation as M i <> M i+13 then it simply finds every equation True (because probably i+13 th row is not equal to your i th row) and hereby it merges everything from bottom to the 2nd row as your For loop is until 2
Sub Merge_Upon_Change()
'Purpose: Merges cells between columns "D" and "L" when column "M" changes
Dim r As Long, i As Long
Application.DisplayAlerts = False 'Turn off windows warning popup
r = Cells(Rows.Count, "D").End(xlUp).row ' find last cell in Column D
For i = r To 2 Step -1
If Cells(i, 13).Value <> Cells(i + 1, 13).Value Then 'upon change in column M = 13
Range("D" & i & ":L" & i).Merge 'then merge column "D" through "L"
End If
Next i
Application.DisplayAlerts = True ''Turn on Windows warning popup
End Sub
The Situation:
On the Cell "A1" I have the value "1"
On the Cell "A10" I have the value "2"
On the Cell "A20" I have the value "3"
On the Cell "A30" I have the value "4"
What I want to do with Excel VBA:
Between A1 and A10 there are empty cells. I want that A2:A9 is filled with the value of A10, that means "2".
Between A10 and A20 there are empty cells. I want that A11:19 is filled with the value of A20, that means "3".
The problem is, the range A1 to A30 is not fixed. I want to search the whole row for cells which are not empty and to fill the cells between them with the upper cell which is filled.
EDIT:
To explain more, I have an Access Database with a table which is filled with Dates and a table which is filled with numbers.
I want to make a Report to an Excel Sheet.
Dim Daten As Variant
Daten = Array(rs!DatumJMinus8Monate, rs!DatumJ, rs!DatumI, rs!DatumH, rs!DatumG, rs!DatumF, rs!DatumE, rs!DatumD, rs!DatumC, rs!DatumB, rs!DatumA, rs!DatumA4Monate)
Dim Bedarfe As Variant
Bedarfe = Array(rs!BedarfJ8Monate, rs!BedarfJ, rs!BedarfI, rs!BedarfH, rs!BedarfG, rs!BedarfF, rs!Bedarfe, rs!BedarfD, rs!BedarfC, rs!BedarfB, rs!BedarfA, rs!BedarfA, "")
Dim neuereintrag As Boolean
bedarfindex = 0
For Each element In Daten
i = 7
For jahre = 1 To 10
If Cells(1, i + 1) = Year(element) Then
For monate = 1 To 12
If Cells(2, i + monate) = Month(element) Then
Cells(zeile, i + monate) = Bedarfe(bedarfindex)
Cells(zeile, i + monate).Font.Bold = True
bedarfindex = bedarfindex + 1
neuereintrag = True
ElseIf IsEmpty(Cells(zeile, i + monate)) Or neuereintrag = True Then
Cells(zeile, i + monate) = Bedarfe(bedarfindex)
neuereintrag = False
End If
Next monate
End If
i = i + 12
Next jahre
Next element
In the picture the numbers in the red circles have to be deleted.
On way to work from the bottom upwards:
Sub FillUp()
Dim N As Long
Dim i As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = N - 1 To 1 Step -1
If Cells(i, 1).Value = "" Then Cells(i, 1).Value = Cells(i + 1, 1).Value
Next i
End Sub
Maybe something like this. It needs a bit of work as it will fail if two values are next to each other, or column 1 doesn't contain a value.
Sub AutoFill()
Dim rCell1 As Range, rCell2 As Range
With ThisWorkbook.Worksheets("Sheet1")
'Find the last column containing data, set both references to this
'so the Do While doesn't fall over on the first loop.
Set rCell2 = .Cells(1, .Columns.Count).End(xlToLeft) '1 is the row number it's looking at.
Set rCell1 = rCell2
'Find next cell to the left containing data and fill between these two columns.
Do While rCell1.Column <> 1
Set rCell1 = rCell2.End(xlToLeft)
.Range(rCell1, rCell2.Offset(, -1)).FillRight
Set rCell2 = rCell1
Loop
End With
End Sub
I have been looking at how to develop a macro that deals with two columns - one holding a code for marriage status and the other relationship status. For example:
SI daughter
M wife
M husband
SI son
D mother
W father
M son
M wife
SI daughter
SI husband
SI stands for single, D for divorced, M for married, W for widowed, and so on.
The purpose of the macro is to test for mistakes, where a daughter or son cannot be other than single, and do that for about 1000 rows, and do so by evaluating the two adjacent cells in every row and returning the row that matches the criteria for a mistake. The mistakes above are that SI cannot be a Husband and M cannot be a Son.
For a single row, the following will do the job:
If Cells(2, 1).Value = "M" And Cells(2, 2).Value = "son" Then
MsgBox "You've found a mistake"
else
MsgBox "Keep checking"
End If
Doing the above for 1000 rows is impractical, so for the purpose of evaluating them, I came up with the following, but it does not work quite to specification:
Sub attempt9()
Dim i As Integer
Dim cell As Range
Dim cell2 As Range
Dim y As Range
Dim z As Range
Set y = Range("A1:A10")
Set z = Range("B1:B10")
For i = 1 To 10
For Each cell In y
cell.Offset(i, 0).Select
For Each cell2 In z
cell2.Offset(i, 0).Select
If cell.Offset(i, 0).Value = "M" And cell2.Offset(i, 0).Value = "husband" Then
Range("D1") = cell.Address & ", " & cell2.Address
End If
Next cell2
Next cell
Exit For
Next i
End Sub
The main issue I'm facing is how to get the loop to move the two adjacent cells row by row in lockstep and return the row or addresses of the erroneous cells. I've programmed the selections to move at the same iteration in both columns with every loop cycle, and so far, it will return the address of the cell with a value "M" in the first column, and the value of a cell with the value "husband" in the second column, but the rows will not match - and there is a strict IF AND condition for the purpose.
Try the following, you just need to use the loop variable to reference the row number and you can use a Select Case block to test all the error situations:
Dim error As Boolean
For i = 1 To 10
Select Case True
Case Cells(i, 1).Value = "M" And Cells(i, 2).Value = "son": error = True
Case Cells(i, 1).Value = "M" And Cells(i, 2).Value = "daughter": error = True
Case Cells(i, 1).Value = "SI" And Cells(i, 2).Value = "husband": error = True
'// repeat above for all error cases
Case Else: error = False
End Select
If error Then
MsgBox "You've found a mistake at row " & i
Exit For '// To stop the code and fix the error
End If
Next
MsgBox "Checking complete!"