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
Related
I have searched a lot about my question but could not find the answer I need.
I have a table A1:DT97138. Within this table I want to check per row, starting from cell B2 to DT2 if all the cells in one row are empty. Then output "Empty" or "Not Empty" in the next cell, DU2. Then do the same for row 3, 4 etc to 97138 (and output the same results row per row in DU2, DU3 etc).
I found out how to do this for 1 specific row, as you can see below, but I cannot find out how to iterate trough the whole range, row by row.
Sub rowEmpty()
Dim rng As Range, r As Range
Set rng = Range("B2:DT97138")
If WorksheetFunction.CountA(Range("B2:DT2")) = 0 Then
Cells(2, 125) = "Empty"
Else
Cells(2, 125) = "Not Empty"
End If
End Sub
Thanks for your help!
Your are doing well. Just need to loop thru the range like this.
Sub rowEmpty()
Dim rng As Range, r As Range
Set rng = Range("B2:DT97138")
For Each r In rng.Rows
If WorksheetFunction.CountA(r) = 0 Then
Cells(r.Row, 125) = "Empty"
Else
Cells(r.Row, 125) = "Not Empty"
End If
Next r
End Sub
Enter your formula at once in the last column:
With Range("DU2:DU97138")
.Formula = "=IF(COUNTA(B2:DT2)=0,""Empty"",""Not Empty"")"
'then eventually convert it to constants
.Value = .Value
End With
No loops, simpler, probably much faster :-)
I'm new to VBA and English isn't my native language so here goes.
I want to conditional format rows/ range (giving them green-colored background) if cell C in that row have duplicate value in column C and also if there's a cell in column O that equals 0, but if the cell in column C has no similar value, don't apply the conditional format to that cell (eventhough cells in column O has the value of 0).
Note: Cells that have same values in column C will always be above and below each other, for example it's possible that C1=C2=C3 but not C1<>C2, C1=C3
I know I'm not explaining it clearly, so please just let me know if you want more information.
Update (more information): I may have 3 or more rows with same C column value above and below each other, and the zero value in column O will always be the bottom row.
Example:
If C1=C2=C3=C4=C5 and O5=0 , Rows 1 2 3 4 5 become green colored.
I prefer using conditional format even if it needs vba code so I dont have to run it everytime there's new 0 in column O.
I've used this code but it doesn't work (obviously), but maybe it's a little different with my question because the real data is more complicated than what I illustrated. My data table starts at 4th row (header on 3rd). This code only formats 1 row (above the row that has zero column O value) and what I need is all rows with same column C value are formatted. Please keep in mind that I'm a newbie in vba :(
With Range("A4:r8000").FormatConditions.Add( _
Type:=xlExpression, _
Formula1:="=AND($C4=$C5,$O5=0,$F4<>0)")
.Interior.Color = 13551615
.Font.Color = -16383844
End With
Try this as the formula for the CFR,
=and(countif(c:c, c1)>1, o1=0, len(o1))
'alternate for part that I am not sure I understand
=and(countif(c$1:c1, c1)>1, o1=0, len(o1))
This will go through and highlight duplicate cells if any of the duplicate cells' rows have '0' in column O. I am still working on a way that will make this auto update whenever a change happens in Column O, but can't quite figure that out. Will update when I do.
Sub ConditionalFormatSE()
Application.ScreenUpdating = False
Dim lastRow As Long
Dim myCell As Range
Dim colCVals As Range
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
Set colCVals = Range("C1", "C" & lastRow)
colCVals.clearformats
For Each myCell In colCVals
If Cells(myCell.Row, 15).Value = "0" Then
If WorksheetFunction.CountIf(colCVals, myCell.Value) > 1 Then
Set c = colCVals.Find(myCell.Value)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.color = RGB(198, 239, 206)
c.Font.color = RGB(0, 97, 0)
Set c = colCVals.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End If
End If
Next myCell
Set colCVals = Nothing
Set myCell = Nothing
Set c = Nothing
Application.ScreenUpdating = True
End Sub
As for making it run automatically, put this in: VBAProject([workbookname].xlsm)->Microsoft Excel Objects->Sheet1([sheetname]) and it should run whenever a value in column 'O' is changed
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Columns(15)
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
Call ConditionalFormatSE
End If
Set KeyCells = Nothing
End Sub
If cells with same values are always grouped (one below the other), following code might do what you want.
Sub Test()
Dim lLastRow As Long
Dim i As Integer
lLastRow = Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To lLastRow
If ((Worksheets("Sheet1").Cells(i + 1, 3).Value = Worksheets("Sheet1").Cells(i, 3).Value) And (Worksheets("Sheet1").Cells(i, 15).Value = "0")) Then
Worksheets("Sheet1").Cells(i, 3).Interior.Color = vbGreen
End If
Next i
End Sub
So I have the following VBA loop set up, but want to add a line that says "If there are two cells within this range that have a value, do this. If there are three cells within a range that have a value, do that." What I have so far is:
Sub Test1()
Dim Rng As Range
Dim i As Long
i = 3
Application.ScreenUpdating = True
While i <= 133
Set Rng = Range("C" & i)
If Rng.Offset(, 2).Resize(, 7) <> "" Then
Rng.Offset(, 1).FormulaR1C1 = "Blank"
i = i + 1
Else: Stop
End If
Wend
End Sub
So I have the VBA script print the word "Blank" into the appropriate cell if this range is empty. But how can I add more lines to say "If one cell in this range contains a value," or "if two cells in this range contain a value"
Here is how you can check if there are more than one non-empty cell in the given range:
If Application.WorksheetFunction.CountA(Rng.Offset(, 2).Resize(, 7)) > 1 Then
Few additional tips to your code:
If you know exactly the initial and final value of i you should use For ... Next loop instead of While ... Wend. So you could replace this code:
i = 3
'(...)
While i <= 133
'(...)
i = i + 1
Wend
with this:
For i = 3 To 133
'(...)
Next i
I think this line of code will cause Type mismatch error:
If Rng.Offset(, 2).Resize(, 7) <> "" Then
because you are trying to compare an object of Range type with a primitive value (empty string). To avoid this issue you can use the similar code as above:
If Application.WorksheetFunction.CountA(Rng.Offset(, 2).Resize(, 7)) = 0 Then
you might like to add code along these lines
Select case Application.WorksheetFunction.CountA(Rng.Offset(, 2).Resize(, 7))
case 0
Rng.Offset(, 1).value = "Blank"
case 1
Rng.Offset(, 1).value = "Only One"
case >2
Rng.Offset(, 1).value = "More than 1"
end select
I am using Excel 2010 and trying to add a bunch of rows placing the sum of columns A and B in column C. If the sum is over 500 I would then like to boldface the number in column C. My code below works works mathematically but will not do the bold formatting. Can someone tell me what I am doing wrong? Thank you.
Public Sub addMyRows()
Dim row As Integer 'creates a variable called 'row'
row = 2 'sets row to 2 b/c first row is a title
Do
Cells(row, 3).Formula = "=A" & row & "+B" & row 'the 3 stands for column C.
If ActiveCell.Value > 500 Then Selection.Font.Bold = True
row = row + 1
'loops until it encounters an empty row
Loop Until Len(Cells(row, 1)) = 0
End Sub
Pure VBA approach:
Public Sub AddMyRows()
Dim LRow As Long
Dim Rng As Range, Cell As Range
LRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("C2:C" & LRow)
Rng.Formula = "=A2+B2"
For Each Cell In Rng
Cell.Font.Bold = (Cell.Value > 500)
Next Cell
End Sub
Screenshot:
An alternative is conditional formatting.
Hope this helps.
Note: The formula in the block has been edited to reflect #simoco's comment regarding a re-run of the code. This makes the code safer for the times when you need to re-run it. :)
So, I'm trying to figure out how to write an Excel macro to populate Column C with either 3 or a 4 depending on the amount of numbers contained in Column B.
I have searched up and down for the right wording to this, but I keep coming up short.
Basically, I need the macro to look at the number of digits in Column B. If there are 12 digits then the number is a UPC, and if there are 13 then the number is an EAN. I then need the macro to populate Column C with a 3 for UPCs and a 4 for EANs. This needs to be for the entire range of rows in the spreadsheet.
Does anyone have any ideas? Thanks a lot in advance!
You don't need to use a dirty old loop, try this (much faster if you have lots of rows):
Sub HTH()
With Sheet1.Range("B1", Cells(Rows.Count, "B").End(xlUp)).Offset(, 1)
.Formula = "=IF(LEN(TRIM(B1))=12,3,IF(LEN(TRIM(B1))=13,4,""""))"
.Value = .Value
End With
End Sub
Or use a user defined function, which has the advantage of changing when the data in column B is updated.
Better yet just use a formula, you don't really need VBA.
Alternative VBA Method (looping the fast way):
Sub HTH()
Dim vArray As Variant
Dim lCnt As Long
With Range("B1", Cells(Rows.Count, "B").End(xlUp))
vArray = .Value
For lCnt = 1 To UBound(vArray, 1)
Select Case Len(Trim(vArray(lCnt, 1)))
Case 12: vArray(lCnt, 1) = 3
Case 13: vArray(lCnt, 1) = 4
Case Else:
End Select
Next lCnt
.Offset(, 1).Value = vArray
End With
End Sub
You can get the length of a cell's value by using Len() like this Len(Range("A1")) for example.
Now you just need to loop through your column and look at each value. If you look for the last used cell and loop only through that range your loop will be faster.
Here is how I would do it:
sub TestUPC()
With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Dim rRng As Range
Set rRng = Range("B1:B" & LastRow)
For Each cell In rRng.Cells
If Len(Trim(cell))=12 then
cell.Offset(0, 1).Value = 3
ElseIf Len(Trim(cell))=13 then
cell.Offset(0, 1).Value = 4
End If
Next
End Sub
An in cell equation could look like this:
=IF(LEN(B1)=12,3,IF(LEN(B1)=13,4," "))
As suggested in the comments you might want to test for spaces depending on your data:
=IF(LEN(TRIM(A1))=12,3,IF(LEN(TRIM(A1))=13,4," "))