excel vba auto-generate email problems - excel

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

Related

Apply IF to range of cells in excel VBA

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","")))

Copy & Export Data from 'Find and Replace' box or searchbox using vba in excel

Actually I dont have any spesific data to referred, only just wonder if it can be done to export the data to another workbook (whether open or closed) by click on selected row in searchbox from active workbook.
Let's says, the data found in active workbook searchbox is in Row 7, then when click on it (in searchbox) so the data will be exported to another workbook. Not necessery to export all the data, maybe need it in Cell D7, F7 & K7 only to export. And target workbook will filled with the exported data to B4(D7), G8(F7) & L9(K7).
Can it be done using VBA codes? Maybe have to created Userform as a 'Find and Replace' box? Maybe there is another way can make it done? Thank you very much in advance if you accept this challenge and wish you good luck.
Post code here:
Yes, it can be done using VBA. This can get you started.
Example
This example finds all cells in the range A1:A500 on worksheet one that contain the value 2, and changes it to 5.
With Worksheets(1).Range("a1:a500")
Set c = .Find(2, lookin:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing
End If
End With
Look here for source and more: https://learn.microsoft.com/en-us/office/vba/api/excel.range.find
Private Sub ListBox_Results_Click()
Dim strAddress As String
Dim strSheet As String
Dim strCell As String
Dim l As Long
Dim lLastRow As Long
Const sRESULTS As String = "Results Sheet"
For l = 0 To ListBox_Results.ListCount
If ListBox_Results.Selected(l) = True Then
strAddress = ListBox_Results.List(l, 1)
strSheet = Replace(Mid(strAddress, 1, InStr(1, strAddress, "!") - 1), "'", "")
Worksheets(strSheet).Select
Worksheets(strSheet).Range(strAddress).Select
With Worksheets(sRESULTS)
lLastRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & lLastRow).Value = Worksheets(strSheet).Range(strAddress).Value
.Range("B" & lLastRow).Value = strAddress
.Range("C" & lLastRow).Value = Now
End With
GoTo EndLoop
End If
Next l
EndLoop:
End Sub

Evaluate/MATCH function in VBA not working when comparing multiple criteria

I've scoured the internet for a solution to this issue.
I have lists that should match and need to be compared reciprocally. I need to compare 5 or so different variables within each row, then using the MATCH function, would identify the first matching row which is then deleted. I will then loop through the list until there are remaining entries that aren't deleted. The reason I need to delete is because there may be multiple matches within each list, but if there are 3 in one list and 4 in another, I would need the 4th (extra) entry to be identified.
Please critique the code I have below, I have yet to create the loop as I think that will be the easy part once I have gotten the MATCH function to work accurately. The standard CSE formula works within the sheet, but I need VBA for the looping ability. Thanks.
I try to verify the value of RowDelete with the msgbox, and return a run-time error 13: "type mismatch". I also tried use the WATCH window to see what result get passed but the actual formula itself doesn't seem to work.
EDIT: This code returns a run-time error '13': type mismatch. I cannot resolve it. I would just like to know what I can do to pass Formula a result I can use (in this instance the first result is row 62). After that I will be able to do everything on my own.
Sub DeleteMatches2()
Dim Ws As Worksheet
Dim Direction As String
Dim OrderType As String
Dim Amount As String
Dim CCY As String
Dim Rate As String
Dim RowCt As Long
Dim Formula As Integer
Dim iRow As Long
Dim colNum As Integer
Dim RowDelete As Long
Set Ws = Sheets("KOOLTRA RAW")
With Ws
RowCt = .Cells(.Rows.Count, 11).End(xlUp).Row - 1
For iRow = 2 To RowCt
Direction = .Cells(iRow, "K").Value
OrderType = .Cells(iRow, "L").Value
Amount = .Cells(iRow, "M").Value
CCY = .Cells(iRow, "N").Value
Rate = .Cells(iRow, "P").Value
Formula = Evaluate("MATCH(1,(""" & OrderType & """ = B:B)*(""" & Direction & """ = C:C)*(""" & Amount & """ = D:D)*(""" & CCY & """ = E:E)*(""" & Rate & """ = H:H),0)")
MsgBox Formula
Exit For
Next iRow
End With
End Sub
I have commented your code in the hope that my comments will help you improve it.
Sub DeleteMatches()
Dim Ws As Worksheet
Dim Direction As Variant
Dim OrderType As Variant
Dim Amount As Variant
Dim CCY As Variant
Dim Rate As Variant
Dim RowCt As Long ' rows and columns should be of Long type
Dim Formula As Variant
Dim iRow As Long
Dim colNum As Long
Dim RowDelete As Long
Set Ws = Sheets("Example") ' don't "select" anything
With Ws
' creating variable for toral rows to cycle through:-
' you aren't "creating" a variable.
' RowCt is the variable and you are assigning a value to it.
RowCt = .Cells(.Rows.Count, 11).End(xlUp).Row - 1
For iRow = 2 To RowCt ' loop through all rows
' assigning a Range to a Variant (Direction etc) assigns the
' Range object to the variant. I have modified the code
' to assign the specified cell's value to the variant.
' A Variant can be anything. It would be better if you
' would declare your variables as String or Double or Integer or Long.
Direction = .Cells(iRow, "K").Value ' Range("K" & iRow)
OrderType = .Cells(iRow, "L").Value ' Range("L" & iRow)
Amount = .Cells(iRow, "M").Value ' Range("M" & iRow)
CCY = .Cells(iRow, "N").Value ' Range("N" & iRow)
Rate = .Cells(iRow, "P").Value ' Range("P" & iRow)
' Formula is a property of the Range object.
' use like .Cells(iRow, "X").Formula = "MATCH(1,((B:B="" & OrderType & "") ......
' Formula = "MATCH(1,((B:B="" & OrderType & "")*(C:C="" & Direction & "")*(D:D="" & Amount & "")*(E:E="" & CCY& "")*(H:H="" & Rate & "")),0)"
' To set a formula, you need to enter the = sign, like
' .Cells(iRow, "X").Formula = " = MATCH(1 ...
' it is best that you test the formula on the worksheet
' before attempting to let VBA write it to a cell.
' Your above formula looks like nothing Excel would be able to execute.
' Please read up on how to use the Evaluate function.
' It can't do what you appear to expect it to do.
' RowDelete = Evaluate(Formula)
MsgBox RowDelete
'colNum = Application.Match(1,((B1:B2=OrderType)*(C1:C2=Direction)*(D:D=Amount)*(E:E=CCY)*(H:H=Rate)),0)
' I think it is the better idea to let VBA execute the MATCH function
' rather than writing the formula to the worksheet.
' However, your "code" has no similarity with what MATCH can do.
' Read up on how to use the the MATCH function correctly.
' When executed by VBA it needs the same syntax as when called from the worksheet.
'Formula = "MATCH(1,((B:B=OrderType)*(C:C=Direction)*(D:D=Amount)*(E:E=CCY)*(H:H=Rate)),0)"
'Formula = "MATCH(1,((B:B=L2)*(C:C=K2)*(D:D=M2)*(E:E=N2)*(H:H=P2)),0)"
'colNum = Worksheets("Example").Evaluate("MATCH(1,((B:B=OrderType)*(C:C=Direction)*(D:D=Amount)*(E:E=CCY)*(H:H=Rate)),0)")
Exit For ' stop the loop here during testing
' remove this stop after your code works
Next iRow
End With
End Sub

Can I insert a variable into a string?

I'm trying to make a program in the Excel VBA that inserts a formula into a column of cells. This formula changes based on the contents of the cell directly to the left.
This is the code I have written so far:
Sub Formula()
Dim colvar As Integer
colvar = 1
Dim Name As String
Name = "Sample, J."
Do While colvar <= 26
colvar = colvar + 1
Name = Range("B" & colvar).Value
Range("C" & colvar).Value = "='" & Name & "'!N18"
Loop
End Sub
As you can see, I want to insert the variable Name between the formula strings, but Excel refuses to run the code, giving me a "application-defined or object-defined error."
Is there a way to fix this?
You will need some error checking in case the sheets don't actually exist in the workbook.
it looks like you are looping through column B that has a list of sheet names and want range N18 to display next to it.
Something like
Sub Button1_Click()
Dim Lstrw As Long, rng As Range, c As Range
Dim Name As String
Lstrw = Cells(Rows.Count, "B").End(xlUp).Row
Set rng = Range("B1:B" & Lstrw)
For Each c In rng.Cells
Name = c
c.Offset(, 1) = "='" & Name & "'!N18"
Next c
End Sub
Or you can just list the sheets and show N18 next to it, run this code in a Sheet named "Sheet1"
Sub GetTheSh()
Dim sh As Worksheet, ws As Worksheet
Set ws = Sheets("Sheet1")
For Each sh In Sheets
If sh.Name <> ws.Name Then
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1) = sh.Name
ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(0, 1) = sh.Range("N18")
End If
Next sh
End Sub
Thank you to everyone for your help! I actually found that I had just made a silly error: the line Do While colvar<=26 should have been Do While colvar<26. The cells were being filled, but the error manifested because one cell was being filled by a nonexistent object.
I did decide to use the .Formula modifier rather than .Value. Thank you to Jeeped for suggesting that.

Excel-VBA: Do a calculation only if cells involve contain values

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

Resources