Cannot figure out how to get VBA to open a link.
I have an if formula In CN2 which will result in 1 of 5 URLs, the cell is clickable and will direct me to one of these URLS.
I thought perhaps VBA code does not like a formula based URL and turns the result into a hyperlink in CO2, but still I could not get it.
my error with the below code is "cannot open the specified file type"
Can anyone please assist?
Sub OpenURLs()
Dim i As Integer
For i = 1 To ActiveSheet.Range("Co2" & Rows.Count).End(xlUp).Row
Dim url As String
url = ActiveSheet.Range("Co2" & i).Value
ActiveWorkbook.FollowHyperlink url ' error here
' Copy the adjacent value in column CM
Dim valueToCopy As String
valueToCopy = ActiveSheet.Range("CM" & i).Value
ActiveSheet.Range("CM" & i).Copy
MsgBox "Click OK to continue to the next URL", vbOKOnly
Next i
End Sub
The bellow code only works IF the cell contains a hyperlink:
Sub OpenUrls()
Dim i As Long
Dim sh As Worksheet
Set sh = ActiveSheet
With sh
For i = 1 To .Range("A" & Rows.Count).End(xlUp).Row
Dim valueToCopy As String
If .Range("A" & i).Hyperlinks.Count > 0 Then
.Range("A" & i).Hyperlinks(1).Follow NewWindow:=False, AddHistory:=False
valueToCopy = .Range("B" & i).Value 'Not being used, decided to leave it
.Range("B" & i).Copy
MsgBox "Click OK to continue to the next URL", vbOKOnly
Application.CutCopyMode = False
End If
Next i
End With
End Sub
Related
I created my first userforms to capture hospital data but now I'm stuck.
I want to change all values for "Current inpatient" in column "B:B" from "yes" to "no" for a given patient when I click "Remove from ITU".
Example data
Userform to change patient from "Yes" to "no" in the "current inpatient" column
Try the next code, please:
Sub ChangeYesToNo()
Dim sh As Worksheet, curInp As String, lastRow As Long, i As Long
Set sh = ActiveSheet
lastRow = sh.Range("A" & Rows.Count).End(xlUp).row
curInp = Me.ComboBox1.Value 'use here your combo name
For i = 2 To lastRow
If CStr(sh.Range("E" & i).Value) = CStr(curInp) Then
If sh.Range("B" & i).Value = "Yes" Then
sh.Range("B" & i).Value = "No"
Else
MsgBox "Strange situation in row """ & i & """."
End If
End If
Next i
End Sub
Not tested, written on a tablet without Excel installed, but it should work...
I'm very new to VBA and trying to figure the below out.
I want my sub to run whenever new data is pasted (or the value is changed) in cell A1 in the CB worksheet.
The second code works perfectly when its ran alone. However, after inserting the first code to run the macro once A1 is change, I get "Run-time error '91: Object variable or with block variable not set" error message.
The error is triggered at this code line "SHT.Range("k" & I).Value = U.Offset(-1, 0)"
How can I make the second macro run once something is pasted or change in cell A1 ?
1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:C" & ThisWorkbook.Worksheets("CB").UsedRange.Rows.Count)) Is Nothing Then
Call LoopandIfStatement
End If
End Sub
2.
Sub LoopandIfStatement()
Dim SHT As Worksheet
Dim I As Long
Dim O As Long
Dim U As Range
Set SHT = ThisWorkbook.Worksheets("CB")
MyLr = SHT.Cells(Rows.Count, 1).End(xlUp).Row
For I = 1 To MyLr
If IsEmpty(SHT.Range("a" & I).Value) = False Then
Set U = SHT.Range("A" & I)
SHT.Range("k" & I).Value = SHT.Range("A" & I).Value
Else
SHT.Range("k" & I).Value = U.Offset(-1, 0)
End If
Next I
For O = 2 To MyLr
If SHT.Range("g" & O).Value = "Closing Balance" Then
SHT.Range("l" & O).Value = SHT.Range("j" & O).Value
End If
Next O
End Sub
It's likely that the crash is caused by the Change event being triggered by a change initiated by your second procedure. Try suppressing events while that procedure is executed.
Application.EnableEvents = False
Call LoopAndIfStatement
Application.EnableEvents = True
I'm trying to add items from a file saved in path "C:\Users\se72497\Desktop" which contains in the 1st column of the sheet called "Departamentos" a series of values I want to add in the Combobox.
My combobox receive the name of dept.
Private Sub UserForm_Initialize()
Dim filename As Workbook
Set filename = Workbooks.Open("C:\Users\se72497\Desktop\Tablas_Macro.xlsx")
With filename.Sheets("Departamentos")
dept.List = Range("A2", .Range("A" & Rows.Count).End(xlUp).Value)
End With
End Sub
I've tried to execute this code but it returns me a run-time error:
Why vba returns me this error?
The .Value is in the wrong place. (Or you could say that the parenthesis is in the wrong place). Correcting this, you have:
.Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
With your current code, .Value is within the Range call, so you're trying to use the value of the cell, not the cell itself, as the 2nd argument.
You want it outside.
Otherwise, if the last cell's value is "foo", then your code is equivalent to
Range("A2", "foo")
which is most certainly not what you want.
So when you click pn your combo box data will get loaded,
' Pre-requisties name the cell A2 with variable rstart
Private Sub UserForm_Initialize()
Dim ws As Worksheet: Set ws = Worksheets("Departamentos")
Dim i As Integer: i = 0
Dim lRow As Long
Dim sAddress As String
On Error GoTo errhandling
If Me.nameofcombobox.Value = vbNullString Then
MsgBox "Select value to continue!"
Else
With ws
lRow = .Range("Departamentos").Rows.Count
'name the cell a2 as rstart
Do Until .Range("rStart").Offset(0, i).Value = Me.nameofcombobox.Value
i = i + 1
Loop
sAddress = .Range("rStart").Offset(0, i - 1).Address
.Range(sAddress & ":" & Left(sAddress, 4) & lRow).Value = .Range(sAddress & ":" & Left(sAddress, 4) & lRow).Value
End With
End If
On Error GoTo 0
MsgBox "Completed without errors", vbInformation, "Success"
FunctionOutput:
Set ws = Nothing
Exit Sub
errhandling:
MsgBox "The following error occurred: " & Err.Description, vbCritical, "Error"
Resume FunctionOutput
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’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