This is my code
Private Sub Send_Click()
Dim cell As Range, Rng As Range
Dim strURL As String
Set Rng = Selection
For Each cell In Rng
strURL = "http://xxxxxxxx.com/excelAPI.php?customer_id=1&mobilenumber=" _
& cell.Value & "&message=" & cell.Offset(0, 1).Value
Call Sheets("Sheet1").WebBrowser4.Navigate(strURL)
Next cell
Set Rng = Nothing
End Sub
i am Highlighted only 3 mobile number in cell A and i click the button it takes only the last number.
Probably easiest to build the string first:
Dim strURL as String
strURL = "http://xxxxxxx.com/excelAPI.php?customer_id=1&mobilenumber=" _
& ActiveCell.Value & "&message=" & ActiveCell.Offset(0,1).Value
Call Sheets("Sheet1").WebBrowser4.Navigate(strURL)
Assuming the active cell contains the mobile number and the cell to it's immediate right contains the required message, otherwise specify the cells:
Dim strURL as String
strURL = "http://xxxxxxx.com/excelAPI.php?customer_id=1&mobilenumber=" _
& Range("A1").Value & "&message=" & Range("B1").Value
Call Sheets("Sheet1").WebBrowser4.Navigate(strURL)
You may need to qualify your range worksheets.
EDIT
As requested in comments to cycle through selected cells:
Dim cell As Range, Rng As Range
Dim strURL as String
Set Rng = Selection
For Each cell In Rng
strURL = "http://xxxxxxx.com/excelAPI.php?customer_id=1&mobilenumber=" _
& cell.Value & "&message=" & cell.Offset(0,1).Value
Call Sheets("Sheet1").WebBrowser4.Navigate(strURL)
Next cell
Set Rng = Nothing
Only select the cells that contain the mobile numbers, otherwise the code will try to send to the messages as well. You may want to write in some check to ensure the cell contains a number such as:
If IsNumeric(cell.Value) Then
Or a more detailed format check depending on what you have in the columns of the worksheet.
Related
I am trying to print a few months worth of time sheets. So print 20 copies of the same sheet, and change the date on one cell (cell "C1" on "Timesheets" sheet) using a list of fortnightly dates on the "Pay Periods" sheet.
Have tried multiple methods but can't get close for varying reasons...
Would be interested to learn why am getting errors or stuck on each method I have tried below.
Sub PrintAllDates()
Dim printDate As Date
Dim startDate As Date
Dim endDate As Date
startDate = Worksheets("Pay Periods").Range("A2")
endDate = Worksheets("Pay Periods").Range("A10")
For printDate = startDate To endDate
Sheets("Timesheet").Range("C1") = printDate
Sheets("Timesheet").PrintOut
Next
This works but I can't figure out how to get it to use the list.
It prints out 9 consecutive days instead, whereas my list is 9 consecutive "fortnights".
Sub PrintCopies()
Dim i As Integer
Dim VList As Variant
VList = Sheets("Pay Periods").Range("H2:H3").Value
For i = LBound(VList) To UBound(VList)
Range("C1") = VList(i)
ActiveSheet.PrintOut
Next
With the above, I get runtime error 9 "Subscript out of range" on Range("C1") = VList(i)
Sub PrintCopies()
Dim i As Date
Dim VList As Variant
VList = Array(Worksheets("Pay Periods").Range("A2:A10"))
For i = LBound(VList) To UBound(VList)
Sheets("Timesheet").Range("C1") = VList(i)
Sheets("Timesheet").PrintOut
Next
This also works, but only 1 page gets printed out.
Date also gets converted to "13 Jan 1900".
The first code does not work because it is not considering the whole range of dates; instead it takes only the value inside the first and last cell, treating them as dates. The code basically takes those dates and covers each day between them. It does not even akwnoledge the others cells between A2 and A10. This one should work:
Sub PrintAllDates()
'Declaring variables.
Dim RngDate As Range
Dim RngDates As Range
Dim RngTarget As Range
'Setting variables.
Set RngDates = Sheets("Pay Periods").Range("A2:A10")
Set RngTarget = Sheets("Timesheet").Range("C1")
'Covering each cell in RngDates.
For Each RngDate In RngDates
'Changing RngTarget.
RngTarget = RngDate.Value
'Printing RngTarget's sheet.
RngTarget.Parent.PrintOut
Next
End Sub
I've also added a feature to check if the given value is a date in this version:
Sub PrintAllDates()
'Declaring variables.
Dim RngDate As Range
Dim RngDates As Range
Dim RngTarget As Range
'Setting variables.
Set RngDates = Sheets("Pay Periods").Range("A2:A10")
Set RngTarget = Sheets("Timesheet").Range("C1")
'Covering each cell in RngDates.
For Each RngDate In RngDates
'Checking if RngDate does not contain a date value.
If Not VBA.Information.IsDate(RngDate.Value) Then
'Asking what to do in case RngDate does not contain a date value.
Select Case MsgBox("Range " & RngDate.Address(False, False) & " in sheet " & RngDate.Parent.Name & " contains the value """ & RngDate.Value & """, which is a non-date value." & vbCrLf & _
vbCrLf & _
vbCrLf & _
"Do you wish to use it and print anyway?" & vbCrLf & _
vbCrLf & _
"Press ""Yes"" to print it anyway." & vbCrLf & _
vbCrLf & _
"Press ""No"" to not print it and proceed to the next value." & vbCrLf & _
vbCrLf & _
"Press ""Cancel"" to stop the macro and print no more.", _
vbYesNoCancel, _
"Non-date value detected" _
)
'If "Cancel" is pressed, the macro is terminated.
Case Is = 2
Exit Sub
'If "Yes" is pressed, the macro goes on.
Case Is = 6
'If "No" is pressed, the macro goes to NextRngDate
Case Is = 7
GoTo NextRngDate
End Select
End If
'Changing RngTarget.
RngTarget = RngDate.Value
'Printing RngTarget's sheet.
RngTarget.Parent.PrintOut
'Checkpoint.
NextRngDate:
Next
End Sub
Your code can be something like this:
Sub PrintAllDates()
Dim listRange As Range ' Your range A2:A10 in "Pay Periods" sheet '
Dim oCurrentCell As Range ' Single cell from this range '
Dim printedSheet As Worksheet ' Target sheet - "Timesheet" '
Dim oTargetCell As Range ' C1 - target cell (to set next date from list) '
Set listRange = Worksheets("Pay Periods").Range("A2:A10")
Set printedSheet = Worksheets("Timesheet")
Set oTargetCell = printedSheet.Range("C1")
For Each oCurrentCell In listRange.Cells
oTargetCell = oCurrentCell
Rem If some cells in "Timesheet" has formulas which reffered to C1,
Rem we need recalc it before printing
printedSheet.Calculate
printedSheet.PrintOut
Next oCurrentCell
End Sub
I'm having trouble getting an offset range into a formula. The idea is to have a user input the text they want to search for in a string, the value if found, and the value if not found. And then turn all of that into a formula that gets inserted in the selected cell in the active sheet. The problem is that the formula returns the value of SearchCell and not the range.
How can I put the range of SearchCell in the formula and not the value of SearchCell?
Sub SearchString()
Dim SelectedCell As Range
Dim SearchCell As Range
Dim SearchValue As Variant
Dim FoundValue As Variant
Dim NotFoundValue As Variant
Set SelectedCell = Application.Selection
Set SearchCell = SelectedCell.Offset(, -1)
SearchValue = InputBox("What do you want to search for?")
FoundValue = InputBox("If found?")
NotFoundValue = InputBox("If not found?")
SelectedCell.Formula = "=IF(ISNUMBER(SEARCH(""*" & SearchValue & "*""," & SearchCell & ")), _
""" & FoundValue & """, """ & NotFoundValue & """)"
End Sub
SearchCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
I am trying to convert a text file to Excel sheet. I have to remove some data elements and copy some data elements to several columns. To remove some data, I have to look for a certain String (RUN). After I have that address, I have to search for the next RUN. Inside those two String range, I have to search for another String (NET) and remove it. I have to do it throughout the datasheet since this is frequent.
Here is the code I am trying to use.
Dim name As String: name = "RUN"
Dim secondName As String: secondName = "NET"
Dim rgSearch As Range
' set the range to entire sheet
Set rgSearch = Range(Cells.Address)
Dim rgSearch1 As Range
Dim cell As Range
'search for first occurrence of RUN
Set cell = rgSearch.Find(name)
Dim tempCell As Range
' If not found then exit
If cell Is Nothing Then
Debug.Print "Not found"
Exit Sub
End If
' Store first cell address
Dim firstCellAddress As String, firstRow As Integer, secondRow As Integer
'store address of first result
firstCellAddress = cell.Address
secondRow = cell.Row
Do
'save range to another range for next iteration
Set tempCell = cell.Select
'row variables are for alternate solution I tried
firstRow = secondRow
Debug.Print "Found: " & cell.Address
' search for next instance
Set cell = rgSearch.FindNext(cell)
,set next instance
secondRow = cell.Row
Set rgSearch1 = Range(tempCell, cell).Select
Loop While firstCellAddress <> cell.Address
I have also tried using
Set rgSearch1 = Range("B" & firstRow + 1 & ":B" & secondRow - 1).Select
instead of putting cells inside the range but I get the same result. That is why those firstRow, secondRow variables are there.
With both ideas, I am getting Object Required error. Could someone please show me what I am doing wrong?
With the union statement I created a range existing of multiple subranges, of Worksheet("data"). I need that range for calculations on another worksheet, Worksheet("weekly"). Therefore I want the address of the range including the sheet name in each subrange. rRng is my range existing of several subranges.
rRng.Address(External:=True) returns: "data!$D$1570:$D$1575,$D$2992:$D$3000,$D$5979:$D$5988"
However, to calculate the average of the cells in this range I need: "data!$D$1570:$D$1575,data!$D$2992:$D$3000,data!$D$5979:$D$5988"
The only solution I found so far is:
Dim range_string As String
range_string = ""
Dim SubRange As range
For Each SubRange In rRng
range_string = range_string & SubRange.Address(External:=True) & ","
Next SubRange
range_string = Left(range_string, (Len(range_string) - 1))
Worksheets("weekly").range("$C2").Formula = "=AVERAGE(" & range_string & ")"
There must be a more easy way. Any suggestions?
Kind regards,
Sandra
Each of those subranges is called an Area. You can loop through the Areas of a range and build the string. Here's an example.
Sub test()
Dim rng As Range
Dim rArea As Range
Dim sForm As String
'union the ranges
Set rng = Sheet1.Range("D1570:d1575")
Set rng = Union(rng, Sheet1.Range("D2992:d3000"))
'loop through the areas and build the string
For Each rArea In rng.Areas
sForm = sForm & rArea.Address(, , , True) & ","
Next rArea
'remove the last comma
sForm = Left$(sForm, Len(sForm) - 1)
'insert the formula
Sheet2.Range("A1").Formula = "=AVERAGE(" & sForm & ")"
Debug.Print Sheet2.Range("A1").Formula
End Sub
The debug.print produces:
=AVERAGE(data!$D$1570:$D$1575,data!$D$2992:$D$3000)
I’m a complete newbie with VBA but have managed to cobble together the following which works fine for my worksheet where I have assigned the code to a command button. My problem is that my worksheet has in excess of 3000 rows and I don’t really want to create 3000 buttons.
My current thinking would be to have a script search a range of cells for a specific condition (i.e. TRUE) then run my original code as a subscript for each cell that matches the condition. I have tried creating a loop to match the condition being searched but don't know how to set the result(s) as an active cell.
Could anyone give me some pointer on how to achieve this or propose a better solution?
Thanks.
Sub Send_FWU_to_E_Drive()
Dim aTemp As String
Dim bTemp As String
Dim cTemp As String
Dim dTemp As String
Dim eTemp As String
Dim subdir As String
aTemp = "c:\test\"
bTemp = "E:\romdata\"
cTemp = ActiveCell.Offset(, -5) & ".fwu"
dTemp = ActiveWorkbook.path
eTemp = "\Firmware files"
subdir = "\Firmware Files\" & ActiveCell.Offset(, -5) & "\" & ActiveCell.Offset(, -5) & ".fwu"
MsgBox "The path of the active workbook is " & dTemp & subdir
If Dir(dTemp & subdir) = "" Then
MsgBox "Please check the file and ensure it is suitable for firmware updating with an SD card."
Exit Sub
End If
MsgBox "The file " & cTemp & " is being copied to " & bTemp
If Dir("e:\romdata", vbDirectory) = "" Then MkDir "E:\romdata"
If Dir(bTemp & "nul") = "" Then
MsgBox "The Destination Directory is missing, please ensure your SD Card is formatted, mapped as drive E and has a romdata directory."
Exit Sub
End If
FileCopy dTemp & subdir, bTemp & cTemp
End Sub
First modify your function to accept a range argument, which we'll call cell:
Sub Send_FWU_to_E_Drive(cell as Excel.Range)
Then change all the ActiveCell references in that Sub to cell.
The sub below loops through each cell in column B of the Active sheet and, if it's TRUE, calls your routine with the cell in column A of that row. So your offsets in the code in Send_FWU_to_E_Drive are all relative to the cell in column A. This code is untested, but should be close:
Sub Test
Dim Cell as Excel.Range
Dim LastRow as Long
With ActiveSheet
LastRow = .Range("A" & .Rows.Count).End(xlup).Row
For Each Cell in .Range("B2:B" & LastRow) 'Search for TRUE in column B
If Cell.Value = TRUE Then
Send_FWU_to_E_Drive cell.Offset(0,-1) 'Column A Cell
End If
Next Cell
End With
End Sub
EDIT: Per #Siddharth's suggestion, here's a Find/FindNext version:
Sub Test()
Dim cell As Excel.Range
Dim LastRow As Long
Dim SearchRange As Excel.Range
Dim FirstFindAddress As String
With ActiveSheet
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
Set SearchRange = .Range("B2:B" & LastRow) 'Search for TRUE in column B
Set cell = SearchRange.Find(what:=True, after:=SearchRange.Cells(1))
If Not cell Is Nothing Then
FirstFindAddress = cell.Address
Send_FWU_to_E_Drive cell.Offset(0, -1)
Do
Send_FWU_to_E_Drive cell.Offset(0, -1)
Set cell = SearchRange.FindNext(after:=cell)
Loop While Not cell Is Nothing And cell.Address <> FirstFindAddress
End If
End With
End Sub