I would need to open a random selected link from a cell to a website in my list. My internet links are put in column B, but I cannot get it to open the hyperlink after it has selected a cell from my list.
Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Set Sh = Worksheets("Sheet1")
With Sh
Set Rng = .Range("C1:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
End With
For Each Cell In Rng
ThisWorkbook.FollowHyperlink Cell.Value
Next Cell
End Sub
Just to be sure I got it right:
The addresses are stored in column B (in your code you're using column C)
You don't want to open all of the addresses, but only one random one?
The addresses are full URLs? (Like "https://stackoverflow.com/")
I tidied up your code a little bit. Read the comments, to understand what is happening.
Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Set Sh = Worksheets(1)
' Get a Range object of all possible addresses
Set Rng = Intersect(Sh.UsedRange, Sh.Range("B:B"))
' Open one random element of them
ThisWorkbook.FollowHyperlink Rng(Int(Rnd * Rng.Count) + 1)
End Sub
Related
I need a code to copy a range of cells (H21:H38) from my source worksheet (Acct Total) to a corresponding column on my target worksheet (COS% Tracking) based on matching headers. But the hiccup I have is that the header is in cell A6 on my source worksheet (Acct Total). I've researched it a bit and I've found this code that worked for someone else:
Sub CopyHeaders()
Dim header As Range, headers As Range
Set headers = Worksheets("ws1").Range("A1:Z1")
For Each header In headers
If GetHeaderColumn(header.Value) > 0 Then
Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("ws2").Cells(2, GetHeaderColumn(header.Value))
End If
Next
End Sub
Function GetHeaderColumn(header As String) As Integer
Dim headers As Range
Set headers = Worksheets("ws2").Range("A1:Z1")
GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)), Application.Match(header, headers, 0), 0)
End Function
So my issue is that I don't know where to begin to edit this code to work like I need. This code worked by using the header above the range of cells but that won't do in my case. I'll attach pictures so that hopefully I'm not too vague.
Can someone help me to edit this code according to my needs?
Edit: Additional Picture for the source of the dates.
GL Code Tab
Look at the following construct as a starting point for a different way to solve the same problem. There are descriptive variables so you have an idea of what is happening.
Edit: As the target sheet row 3 is locked, code has been amended to use Match function to return column number where string is found (if found).
Essentially:
Set your source and target worksheets.
Set sourceWorksheet = wb.Sheets("Acct Total")
Set targetWorksheet = wb.Sheets("COS% Tracking")
Define your target value (the date you are trying to match on) and source range
targetDate = Trim$(sourceWorksheet.Range("A6"))
Set sourceRange = sourceWorksheet.Range("H21:H38")
Find the column number of where value (targetDate) is present in the target sheet
colNum = Application.WorksheetFunction.Match(targetDate, searchRange, 0)
Add error handling in case it is not present i.e. if date (as string) is not found....
ErrHand: 'code in this section.....
Set the address of where the target data will be pasted
Set targetRange = .Range(Cells(4, colNum), Cells(21, colNum))
Set the target range to be equal to the source range.
targetRange.Value = sourceRange.Value
Adapt as appropriate.
Putting it together you getting something along the lines of the following:
Option Explicit
Public Sub copydata()
Dim sourceRange As Range
Dim targetDate As String
Dim targetRange As Range
Dim wb As Workbook
Dim sourceWorksheet As Worksheet
Dim targetWorksheet As Worksheet
Dim searchRange As Range
Set wb = ThisWorkbook
Set sourceWorksheet = wb.Sheets("Acct Total")
Set targetWorksheet = wb.Sheets("COS% Tracking")
targetDate = Trim$(sourceWorksheet.Range("A6"))
Set sourceRange = sourceWorksheet.Range("H21:H38")
Set searchRange = targetWorksheet.Rows(3)
On Error GoTo ErrHand
Dim colNum As Long
colNum = Application.WorksheetFunction.Match(targetDate, searchRange, 0)
With targetWorksheet
Set targetRange = .Range(Cells(4, colNum), Cells(21, colNum))
targetRange.Value = sourceRange.Value
End With
ErrHand:
If Err = 1004 Then
MsgBox "Not found: " & targetDate
Err.Clear
Exit Sub
End If
End Sub
See the following:
Finding address of text in worksheet
Moving data between sheets
I was able to copy the rows to another workbook by using predefined ranges. However, I wanted to make sure that it only needs to copy those with values. I've been formulating this code but it returns an error -1004
Private Sub test()
Dim WBa As Workbook, MyPathA As String
Dim FinalRow As Long
Dim getDBsht As Worksheet
MyPathA = "sharepoint.com/Financial Tracker v8.xlsx"
ThisWorkbook.Sheets("ConTracker_DB").UsedRange.ClearContents
' Attempt to open a sharepoint file
Set WBa = Workbooks.Open(MyPathA)
'Set WBb = Workbooks.Open(MyPathB)
Set getDBsht = WBa.Sheets("ConTracker_DB")
getDBsht.UsedRange.Copy
'error starts here
ThisWorkbook.Sheets("ConTracker_DB").UsedRange.Paste
Application.CutCopyMode = False
WBa.Close
Set WBa = Nothing
End Sub
UPDATED CODE: UsedRange fixed my copy rows with value only, but pasting error still persists
You could iterate the individual cells and copy only those which have a value:
Dim sourceCell as Range
Dim targetCell as Range
Set targetCell = ThisWorkbook.Sheets("ConTracker_DB").Range("A1").
For each sourceCell in Range("theNamedRangeYouWantToCopyFrom")
'I'm not sure if you need a dynamic range to copy from, but if you don't...
'...it's much easier to use a "named range" for that.
If sourceCell.Value <> "" Then
targetCell.Value = sourceCell.Value
Set targetCell = targetCell.Offset(1,0)
End If
Next sourceCell
Try defining the final column you need copied and then defining the start and end cells in the range:
FinalCol = 23 '(or whatever you need)
getDBsht.Range(getDBsht.Cells(1, 1), getDBsht.Cells(FinalRow, FinalCol)).Copy
Also note that above I'm specifying which worksheet the cells in the range come from. This can help if you have multiple workbooks/worksheets open at once.
Defining the destination before you start copying is a good idea, too.
CopyTo = ThisWorkbook.Sheets("ConTracker_DB").Range("A1")
Answering my question :))
Basically if you're using usedRange.Copy
you should be pasting with
Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Please find below for the complete code if you're using this:
Private Sub test()
Dim WBa As Workbook, MyPathA As String
Dim FinalRow As Long
Dim getDBsht As Worksheet
MyPathA = "sharepoint.com/Financial Tracker v8.xlsx"
ThisWorkbook.Sheets("ConTracker_DB").UsedRange.ClearContents
' Attempt to open a sharepoint file
Set WBa = Workbooks.Open(MyPathA)
'Set WBb = Workbooks.Open(MyPathB)
Set getDBsht = WBa.Sheets("ConTracker_DB")
getDBsht.UsedRange.Copy
ThisWorkbook.Sheets("ConTracker_DB").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
WBa.Close
Set WBa = Nothing
End Sub
Objective: open 4 excel workbooks from specific directory paths, which are listed in the "macros" tab, range "C2:C5"
Issue: I've recently started using VBA. Code gets through testing until "ThisWorkbook.FollowHyperlink hL.Value"
Question: Where did I go wrong?
Thanks for any comments
Code:
Sub Update1()
Dim Sh As Worksheet
Dim Rng As Range
Dim hL As Range
Set Sh = Worksheets("macros")
With Sh
Set Rng = .Range("C2:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
End With
For Each hL In Rng
ThisWorkbook.FollowHyperlink hL.Value
Next hL
End Sub
Rather than using
ThisWorkbook.FollowHyperlink hL.Value
try
Workbooks.Open(hL.Value)
(Assuming you have the full paths combined with file name in your list.)
Help needed. I'm a newbie to VBA and trying to start with simple macro.
But even with that failing miserably.
All i'm trying to do is copy and paste from one worksheet to another using an input box to specify the range to be copied.
Now I know for the input box is:
Application.InputBox("Enter the range from which you want to copy : ", Type:=8)
But what do line do i need in order to copy to a cell in another worksheet?
I apologise in advance for being an idiot.
Is this what you are trying?
Option Explicit
Sub Sample()
Dim rngCopyFrom As Range
On Error Resume Next
Set rngCopyFrom = Application.InputBox("Enter the range from which you want to copy", Type:=8)
On Error GoTo 0
If Not rngCopyFrom Is Nothing Then
'~~> Copy the range to say Cell A1 of Sheets("weekly raw")
rngCopyFrom.Copy ThisWorkbook.Sheets("weekly raw").Range("A1")
End If
End Sub
One way to do it is like this:
Sub CopyRange()
Dim FromRange As Range
Dim ToRange As Range
Set FromRange = Application.InputBox("Enter the range from which you want to copy : ", Type:=8)
Set ToRange = Application.InputBox("Enter the range to where you want to copy : ", Type:=8)
FromRange.Copy ToRange
'Or you can do it like this if you need some flexibility on Paste
'FromRange.Copy
'ToRange.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
End Sub
Here's some sample code:
Option Explicit
Sub CopyStuff()
Dim x As Range
Dim y As Range
Set x = Application.InputBox("Select what copy using the mouse", Type:=8)
Set y = ActiveWorkbook.Sheets("Sheet2").Range("A1")
x.Copy y
End Sub
I am new to VBA and basically trying to write my first macro. It is meant to copy entries from one workbook to another omitting repeating values. I have the following code:
Dim s As String
Do While IsEmpty(ActiveCell) = False
If ActiveCell.Value <> s Then
s = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Windows("Main.xlsm").ActiveCell.Value = s
Windows("Main.xlsm").ActiveCell.Offset(1, 1).Select
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
It gives me Runtime error 1004 for this line:
Windows("Main.xlsm").ActiveCell.Offset(1, 1).Select
Which means that method Select didn't work properly. (I have "Main.xlsm" opened but not active and a cell is selected.)
I searched similar questions and found that it may be because I haven't selected a sheet.
But somehow this line works:
Windows("Main.xlsm").ActiveCell.Value = s
And I can see that cell changed in workbook "Main.xlsm". So, I assume that Windows("Main.xlsm").ActiveCell does create a Range object.
Then why does the error happen? And what is the correct way to write this?
Also I tried changing my code to:
Windows("Main.xlsm").ActiveSheet.ActiveCell.Value = s
Windows("Main.xlsm").ActiveSheet.ActiveCell.Offset(1, 1).Select
Which gave me: "Runtime Error 438 Object doesn't support this property or method". Why is that? What's incorrect here?
And to:
Windows("Main.xlsm").Sheets("Name").ActiveCell.Value = s
Windows("Main.xlsm").Sheets("Name").ActiveCell.Offset(1, 1).Select
Which resulted the same way. And I still don't understand why two last don't work.
This is my first post here so if my editing or anything else is wrong please correct me.
Thanks!
Using ActiveCell, Select etc is not a good idea. Browse through SO Excel tag and you will find many answers advocating against it, many with good explanations why. For one of mine see this question
Instead, declare Range and Worksheet variables and assign these to your ranges and sheets
Dim wbSource as WorkBook
Dim wsSource as WorkSheet
Set wbSource = Application.Workbooks("Main.xlsm")
Set wsSource = wbSource.Worksheets("Name")
To use the workbook the VBA is in, use the ThisWorkbook object
If you want to start with the active sheet, it usuallu OK to use
Dim sh as Worksheet
Set sh = ActiveSheet
To work with a range, use something like
Dim rng as Range
' Set to a specific range
Set rng = Range sh.Range("A1:D10")
' or
With sh
Set rng = .Range(.Cells(1,1), .Cells(10,4))
End With
' Set to all used cells in a column
With sh
Set rng = .Range(.Cells(1,1), .Cells(.Rows.Count,1).End(xlUp))
End With
' Adjust rng
Set rng = rng.Offset(1,0)
Set rng = rng.Resize(10,1)
So, to refactor your code fragment
Dim s As String
Dim rng as Range, cl as Range
Dim shSource as Worksheet
Dim rngDestination as Range
Set shSource = Application.Workbooks("Main.xlsm").Worksheets("SheetName")
Set rngDestination = shSource.Range("A1") ' Change to whatever you need here
Set rng = ActiveCell ' if you must!
' Just in case only one cell entry exists, avoid selecting down to bottom of sheet
If Not IsEmpty(rng.Offset(1,0)) Then
Set rng = Range(rng, rng.End(xlDown)) ' unqualified Range (ie no sh. part) refers to the active sheet
End IF
For Each cl In rng
If cl.Value <> s Then
s = cl.Value
rngDestination.Value = s
Set rngDestination = rngDestination.Offset(1, 1) ' should this be .Offset(1, 0) ?
End If
Next