I'm trying to have the following code applied to cells 19:500 in Column I. If I remove the set Range line of code, I19 updates properly but Once i add the range, the following code stops working? Does anyone know where I'm going wrong? Thanks!
Sub Status_Load()
Dim Cell As Range
Dim Range As Range
Dim Today As Date
With Sheet1
Set Range = .Range("I19:I500")
For Each Cell In Range
If Range("N19").Value = Empty Then Exit Sub
If Range("O19").Value <> Month(Today) Then
Range("I19").Value = "Carried"
ElseIf Range("S19").Value <> "" Then
Range("I19").Value = "Closed"
Else: Range("I19").Value = "Open"
End If
Next Cell
End With
End Sub
Use a regular For...Next loop and loop the rows:
Dim i as Long
For i = 19 to 500
If IsEmpty(.Range("N" & i).Value) Then Exit Sub
If .Range("O" & i).Value <> Month(Date) Then
.Range("I" & i).Value = "Carried"
ElseIf .Range("S" & i).Value <> "" Then
.Range("I" & i).Value = "Closed"
Else
.Range("I" & i).Value = "Open"
End If
Next
Side notes (as mentioned in comments):
Dim Range As Range: bad idea. Don't reuse members of the object model as variable names.
If you don't add the . in front of each Range call within the loop, then you're not actually referencing the With Sheet1.
Dim Today As Date. Perhaps you didn't include the line in your question Today = Date? In any case, you can just drop that variable and use Date directly, i.e. Month(Today) --> Month(Date).
EDIT:
As discussed in the comments, you may just be able to use a formula here and avoid VBA:
=IF(S66<>"","Closed",IF(AND(O66<>"",OR(MONTH(O66)<>MONTH(TODAY()),YEAR(O66)<>YEAR(TODAY()))),"Carried",IF(N66<>"","Open","")))
Related
I would like to solve the following problem:
In Worksheet1 I have a range in text form from O3 to O4500. If the cells in this range contain certain words, I want an "x" to be put in the range U3:U4500 (in the same row). The words to be tested are in range B4:B15 in another Worksheet (Worksheet2).
I made it work with the following code (solution1), but now I don't want to type the code manually for word1, word2, words3... instead it should be taken from the other range in Worksheet 2 (see my draft below in solution2). I believe the problem are the "* *" which are missing when I use the referral to the other range.
Any help is very much appreciated!
Sub solution1()
Dim i As Long
For i = 3 To 4500
If LCase$(Worksheet1.Range("O" & i).Value) Like "*word1*" Or _
LCase$(Worksheet1.Range("O" & i).Value) Like "*word2*" Or _
LCase$(Worksheet1.Range("O" & i).Value) Like "*word3*" Then
Worksheet1.Range("U" & i).Value = "x"
End If
Next
End Sub
Sub solution2()
Dim i As Long, c As Long
For i = 3 To 4500
For c = 4 To 15
If LCase$(Worksheet1.Range("O" & i).Value) Like LCase$(Worksheet2.Range("B" & c).Value) Then
Worksheet1.Range("U" & i).Value = "x"
End If
Next
Next
End Sub
try something like:
Sub solution2()
Dim i As Long, c As Long
searchstring = LCase$(Worksheets("Worksheet2").Range("B1").Value & "|" & Worksheets("Worksheet2").Range("B2").Value & "|" & Worksheets("Worksheet2").Range("B3").Value)
For i = 2 To 9
If Len(LCase$(Worksheets("Worksheet1").Range("O" & i).Value)) < 1 Then GoTo neexxtt
'line above prevents empty lines to be marked
If InStr(searchstring, LCase$(Worksheets("Worksheet1").Range("O" & i).Value)) <> 0 Then Worksheets("Worksheet1").Range("U" & i).Value = "x"
neexxtt:
Next
End Sub
A VBA Lookup: Using an (Array)Formula For Partial Matches
In Excel, in cell U3, you could use the following array formula:
=IF(COUNT(MATCH("*"&Sheet2!$B$4:$B$15&"*",O3,0))>0,"X","")
and copy it down (adjust the lookup worksheet name (Sheet2)).
The following solution is based on this formula avoiding any loops.
Sub VBALookup()
Const Flag As String = "x"
' Reference the ranges.
Dim srg As Range ' Source
Dim drg As Range ' Destination
Dim lrg As Range ' Lookup
With Worksheet1
Set srg = .Range("O3", .Cells(.Rows.Count, "O").End(xlUp))
Set drg = srg.EntireRow.Columns("U")
End With
With Worksheet2
Set lrg = .Range("B4", .Cells(.Rows.Count, "B").End(xlUp))
End With
' Build the array formula.
Dim ArrayFormula As String
ArrayFormula = "=IF(COUNT(MATCH(""*""&'" & Worksheet2.Name & "'!" _
& lrg.Address & "&""*""," & srg.Cells(1).Address(0, 0) & ",0))>0,""" _
& Flag & ""","""")"
' Write the formulae (values).
With drg
' Write the array formula to the first cell.
.Cells(1).FormulaArray = ArrayFormula
' Autofill to the bottom.
.Cells(1).AutoFill .Cells, xlFillDefault
' Not sure, but instead of the previous 2 lines, in Office 365,
' the following single line should work:
'.Cells.Formula = ArrayFormula
' Convert to values (out-comment if you want to keep the formulae).
.Value = .Value
End With
End Sub
Sub test2()
r = ActiveSheet.Range("K" & Rows.Count).End(xlUp).Row
Range("$M2:$M" & r & " ").Formula = "=IF(ISNUMBER(SEARCH(""14 5415 Ruggge"",K2)),""PAD-LAPTOP"",""Yes"")"
End Sub
I had used this command in order to use multiple conditions. how can i use else condition in this command?
I suggest you to edit your question. Otherwise people will minus it lowering your rating (like somebody did already). It is not so clear what you are trying to do, but to iterate through range and output certain value to its Offset is something like this:
Option Explicit
Sub test2()
Dim cell
Dim lRow As Long
lRow = ActiveSheet.Cells(Rows.Count, 11).End(xlUp).Row
For Each cell In ActiveSheet.Range("K1:K" & lRow)
If cell.Value = "apple" Then
cell.Offset(0, 2).Value = "PAD-LAPTOP"
Else
cell.Offset(0, 2).Value = "Yes"
End If
Next cell
End Sub
I would like to know what happened to my codes below.
I am trying to auto-generate emails based on a list of emails and the list can be changed. Therefore, I have to use do until loop (till range ("A" & i) is empty)
auto generate email pic
I am new to VBA and just trying to learn.
Sub own()
Dim shName As String
Dim cell As Range
Dim i As Integer
i = 10
Do Until Range("A" & i).Value = ""
shName = Range("A" & i).Value
ThisWorkbook.Worksheets(shName).Copy
Application.Dialogs(xlDialogSendMail).Show cell.Offset(0, 1).Value, cell.Offset(0, 2).Value
i = i + 1
Loop
End Sub
The error message is invalid procedure call or argument..
why?
The expected result should be able to send out email according to the list (which can be changed and therefore do until loop is used) .
You have at least one object cell in your code that needs to be Set.
Do you have a sheet that actually has the name of the email you are trying to send? Because that is what your code attempts to do.
I've modified your code from a Do... Loop to For... Next. It's too easy to get stuck in a endless loop withou knowing what is wrong.
Whether this code will work depends on your input variables.
Sub own()
Dim shName As String
Dim cell As Range
Dim ws As Worksheet
Dim i As Integer
Set cell = ActiveCell 'or whatever refrence needed
For i = 1 To 10
If Not (Range("A" & i).Value = "") Then
shName = Range("A" & i).Value
'Is there a worksheet that corresponds to the email name?
ThisWorkbook.Worksheets(shName).Copy
Application.Dialogs(xlDialogSendMail).Show _
cell.Offset(0, 1).Value, cell.Offset(0, 2).Value
End If
Next i
End Sub
I need to complete this code, can you help me?
I have to use it inside an Excel macro.This macro have to check if what is written in each cell (inside them there are song names) is present in a specific folder in the form of files. For example if in a cell there is "Nothing Else Matter", the script will have to check if in that folder there is a file with that name. This is a script that should allow me to save time, I apologize for the errors but it is the first time I put my hand to this language (not my work, I say it for fairness).
The error that comes out is as follows:
Compilation error:
Syntax error
The problem is on the line with "If Dir(songname) "" Then"
Sub Test_if_File_exists_in_dir()
Dim RangeOfCells As Range
Dim Cell As Range
Dim songname As String
Dim TotalRow As Long
TotalRow = Range("A" & Rows.Count).End(xlUp).Row
Set RangeOfCells = Range("A2:A" & TotalRow)
For Each Cell In RangeOfCells
songname = "C:\Alessio\Songs\" & Cell & ".*"
If Dir(songname) "" Then
Cell.Font.Color = vbRed
Else
Cell.Font.Color = vbBlack
End If
Next Cell
MsgBox "Done, verify data first time"
End Sub
Thank you,
Alessio
Try this:
Sub Test_if_File_exists_in_dir()
Dim RangeOfCells As Range
Dim Cell As Range
Dim songname As String
Dim TotalRow As Long
TotalRow = Range("A" & Rows.Count).End(xlUp).Row
Set RangeOfCells = Range("A2:A" & TotalRow)
For Each Cell In RangeOfCells
'edit: include artist
songname = "C:\Alessio\Songs\" & _
Cell.Offset(0, 1) & " - " & Cell & ".*"
Debug.print "Checking: " & songname
Cell.Font.Color = IIf(Len( Dir(songname) ) = 0, vbRed, vbBlack)
Next Cell
MsgBox "Done, verify data first time"
End Sub
I have the code that nicely calculates the average I want. But now I want it to only run the calculation if the referenced cells contain values. I am totally stumped on how to feed conditions into my code.
Dim i%
Dim rng As Range
Dim last&
last = Range("A65536").End(xlUp).Row
For i = 2 To last
Range("F" & i).FormulaR1C1 = _
"=AVERAGE(R[-4]C[-2],R[-2]C[-2],RC[-2],R[2]C[-2],R[5]C[-2],)"
Next i
End Sub
I tried working with AVERAGEIF, but I can't get it to work either. the range gives me a #Value in the range whenever I try to set it using the function wizard. So I have no idea how to make it work in VBA.
Any and all help would be appreciated.
*Edit - I only want the average line to appear in the cells, but I want to test the cells for values before doing the calculation. (Siddharth, thanks for your answer anyway!) To clarify:
Dim i%
Dim rng As Range
Dim last&
last = Range("A65536").End(xlUp).Row
For i = 2 To last
'test for all cells having values here
Range("F" & i).FormulaR1C1 = _
"=AVERAGE(R[-4]C[-2],R[-2]C[-2],RC[-2],R[2]C[-2],R[5]C[-2],)"
Next i
End Sub
***Edit 2: To be more clear as to what I'm looking for, I want something like this:
Dim i%
Dim last&
last = Range("A65536").End(xlUp).Row
For i = 2 To last
While Range("D" & i - 4).Value <> "" And Range("D" & i + 4).Value <> ""
Range("F" & i).FormulaR1C1 = _
"AVERAGE(R[-4]C[-2],R[-2]C[-2],RC[-2],R[2]C[-2],R[5]C[-2]))"
Wend
Next i
But my while statement is giving me trouble, as I keep getting an error when I reach that point in the code. I also have tried:
While Range("D" & i - 4 And "D" & i + 4).Value <> ""
Which gives me run time error 13: type mismatch.
If I understand you correctly then you need to check if the number of cells in a range equal the number of filled values. For example
Sub a()
Dim i%
Dim rng As Range
Dim last&
last = Range("A65536").End(xlUp).Row
For i = 2 To last
Range("F" & i).FormulaR1C1 = "=if(" & _
"Rows(R[-4]C[-2])+Rows(R[-2]C[-2])+Rows(RC[-2])+Rows(R[5]C[-2])<>" & _
"COUNTA(R[-4]C[-2],R[-2]C[-2],RC[-2],R[2]C[-2],R[5]C[-2],)-2,""Blank""," & _
"AVERAGE(R[-4]C[-2],R[-2]C[-2],RC[-2],R[2]C[-2],R[5]C[-2],))"
Next i
End Sub