Break External Links Only for Specific Range in a Worksheet - vba

Sub BreakLinks()
Dim wb As Workbook
Set wb = Application.ActiveWorkbook
If Not IsEmpty(wb.LinkSources(xlExcelLinks)) Then
For Each link In wb.LinkSources(xlExcelLinks)
wb.BreakLink link, xlLinkTypeExcelLinks
Next link
End If
End Sub
This code breaks all the external links the active workbook. How can I do it for a selected range in a particular sheet ?
Also, I want to first show the external links in a list(from the selected range), and then 2 buttons : 1 to delete them and 2nd to cancel.
Any help would be appreciated.

LinkSources(xlExcelLinks) is a method of the Workbook - MSDN Workbook.LinkSources, thus it is does not provide .BreakLink to cells.
However, you can loop through the cells with formulas in a given range (givenRange.SpecialCells(xlCellTypeFormulas)) and check whether they contain [, which is needed for the link formula. If they have it, simply write the formulas as values:
Option Explicit
Sub BreakLinks()
Dim givenRange As Range
Set givenRange = Selection
Dim myCell As Range
For Each myCell In givenRange.SpecialCells(xlCellTypeFormulas)
If InStr(myCell.Formula, "[") Then
Debug.Print myCell.Address
myCell.Value2 = myCell.Value2
End If
Next myCell
End Sub

Solution:
1: Create a userform containing a list where all the external links will be listed
2: Set a custom range on a specific sheet and loop through the cells on that range using:
.SpecialCells(xlCellTypeFormulas)
3: Find the cells that contain an external link using:
InStr(1, rCell.Formula, "[") > 0 Then
4: Redim your array and store the cell.address in your array
5: Fill your listbox on your userform through your array (one could also just immediately fill the listbox in the initial loop)
6: Select a value in your listbox and use a button to delete the external link (use find or make sure you have stored your cell.address)
7: You could make your list a multiselect one offcourse.....
EDIT Basically what #Vityata explains in code aswell (beaten me to it :))

Related

VBA - Highlight Cell With Checkbox

Some logic to my process:
In column K on my worksheet I have inserted check boxes from cell K3 - K53 (this could become longer in the future) using the developer tab.
I then associated the check box with the same cell it is placed in.
I formatted the cells in this column by going to 'Format Cells', clicking on 'Custom' then typing in ';;;'. This was to HIDE the 'True/False' text from view.
My next step is to change the cell colour based on the text.
Note:
I have searched through a few forums and combined some code samples from them all, so I will not be able to reference the sources exactly, but below is what I have so far:
Code:
Sub Change_Cell_Colour()
Dim xName As Integer
Dim xChk As CheckBox
Dim rng As Range
Dim lRow As Long
lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
Set rng = ActiveWorksheet.Range("K2:K" & lRow)
For Each xChk In ActiveSheet.CheckBoxes
xName = Right(xChk.Name, Len(xChk.Name) - 10)
If (Range(xChk.LinkedCell) = "True") Then
rng.Interior.ColorIndex = 6
Else
rng.Interior.ColorIndex = xlNone
End If
Next
End Sub
I keep getting an error on the line where I try to get the last row.
Code:
lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
Error:
Object Required
I am not even sure if the code I have will solve my issue, so any help solving the main issue highlighting a cell based on the check box being checked or not, will be greatly appreciated.
Here's a quick rewrite with LOTS of comments explaining:
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Be explicit about which worksheet. Leaving it to "Activeworksheet" is going to cause problems
' as we aren't always sure which sheet is active...
'Also in this case we don't need to know the last row. We will iterate checkbox objects, not
' populate rows.
'lRow = ActiveWorksheet.Cells(Rows.Count, "B").End(xlUp).Row
'Again... we don't need this. We just need to iterate all the checkboxes on the sheet
'Set rng = ActiveWorksheet.Range("K2:K" & lRow)
'This is good stuff right here, just change the ActiveSheet to something more explicit
' I've changed this to the tab named "Sheet1" for instance.
For Each xChk In Sheets("Sheet1").CheckBoxes
'Getting the name of the checkbox (but only the last 10 characters)
xName = Right(xChk.Name, Len(xChk.Name) - 10)
'We can check the linked cell's value, but we can also just check if the
' if the checkbox is checked... wouldn't that be easier?
'If (Range(xChk.LinkedCell) = "True") Then
If xChk.Value = 1 Then
'Now we can use the "LinkedCell", but it's a STRING not a RANGE, so we will have
' to treat it as the string name of a range to use it properly
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
Next
End Sub
Here's the barebones version just to get it working
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Loop through each checkbox in Sheet1. Set it to color 6 if true, otherwise no color
For Each xChk In Sheets("Sheet1").CheckBoxes
If xChk.Value = 1 Then
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
Next
End Sub
I'm totally assuming here, but I would imagine you want this macro to fire when a checkbox is clicked. There is a handy Application.Caller that holds the name of the object that caused a macro to be called. You can set the "Assign Macro.." of each checkbox to this new code and then you can figure out which checkbox called the subroutine/macro using application.caller and follow the same logic to toggle it's linked cell color:
Sub Change_Cell_Colour()
Dim xChk As CheckBox
'Who called this subroutine/macro?
Dim clickedCheckbox As String
clickedCheckbox = Application.Caller
'Lets check just this checkbox
Set xChk = Sheets("Sheet1").CheckBoxes(clickedCheckbox)
'toggle its color or colour if you are a neighbour
If xChk.Value = 1 Then
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = 6
Else
Sheets("Sheet1").Range(xChk.LinkedCell).Interior.ColorIndex = xlNone
End If
End Sub
highlighting a cell based on the check box being checked or not
Select the sheet and apply a CF formula rule of:
=A1=TRUE
ActiveWorksheet doesn't exist, and because you haven't specified Option Explicit at the top of your module, VBA happily considers it an on-the-spot Variant variable.
Except, a Variant created on-the-spot doesn't have a subtype, so it's Variant/Empty.
And ActiveWorksheet.Cells being syntactically a member call, VBA understands it as such - so ActiveWorksheet must therefore be an object - but it's a Variant/Empty, hence, object required: the call is illegal unless ActiveWorksheet is an actual Worksheet object reference.
Specify Option Explicit at the top of the module. Declare all variables.
Then change ActiveWorksheet for ActiveSheet.

How to change range reference with VBA

I have about 300 named ranges that are referring to an external spreadsheet.
for example
Range name: my_range
Refers to: ='\mycompany.com\lucas[Lucas.xlsm]SHEETNAME'!$C$10
I want to replace the "\mycompany.com\lucas[Lucas.xlsm]" with an empty string
I tried researching this online but it doesn't seem like I'm able to phrase it correctly, all the answers are referring to find and replace in cells...
There are a number of resources for doing this in VBA (300+ is a lot to do by hand!).
A great general guide is here: The SpreadsheetGuru's guide to Named Ranges in VBA
To loop through all named ranges and all named ranges in a specific worksheet:
Sub NamedRange_Loop()
'PURPOSE: Delete all Named Ranges in the Active Workbook
'SOURCE: www.TheSpreadsheetGuru.com
Dim nm As Name
'Loop through each named range in workbook
For Each nm In ActiveWorkbook.Names
Debug.Print nm.Name, nm.RefersTo
Next nm
'Loop through each named range scoped to a specific worksheet
For Each nm In Worksheets("Sheet1").Names
Debug.Print nm.Name, nm.RefersTo
Next nm
End Sub
To change the link, instead of using Debug.Print, edit the RefersTo. I can't find a way to directly edit the link, all the documentation suggest that you'd have to delete the link and recreate it with a new reference.
Deleting is easy - nm.Delete
Creating is easy:
'For Workbook level links
ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=cell
'For Worksheet level links
Worksheets("Sheet1").Names.Add Name:=RangeName, RefersTo:=cell
See also:
Names Object
Names.Add Method
Defining and using names in VBA formulas
Looping through all named ranges in excel VBA in current active sheet
If you replace the referring address of a named range with an empty string, Excel deletes the named range. And this is the way I am using to delete a named range:
Public Sub DeleteName(sName As String)
On Error GoTo DeleteName_Error
ActiveWorkbook.Names(sName).Delete
Debug.Print sName & " is deleted!"
On Error GoTo 0
Exit Sub
DeleteName_Error:
Debug.Print sName & " not present or some error"
On Error GoTo 0
End Sub
Simply call it like this:
DeleteName my_range
Actually, the deletion of the named range without .RefersTo is quite clever by the Excel developers - otherwise plenty of errors would appear. Check it out, this code would run only once if you declare my_range1 and my_range2:
Public Sub TestMe()
Dim nameArray As Variant
nameArray = Array("my_range1", "my_range2")
Dim myNameRange As Name
For Each myNameRange In ThisWorkbook.Names
Dim cnt As Long
For cnt = LBound(nameArray) To UBound(nameArray)
If nameArray(cnt) = myNameRange.Name Then
Debug.Print myNameRange
Debug.Print myNameRange.RefersTo
myNameRange.RefersTo = vbNullString
End If
Next cnt
Next myNameRange
End Sub
You should be able to do that from the Data, Edit Links dialog. Select the link in question, click change source and point it to the workbook itself.
If that fails, download my FlexFind tool (http://jkp-ads.com/officemarketplaceff-en.asp), run it and make sure you check the Objects checkbox on the dialog.

Creating a Sheet List using Listbox

In a User form using a Listbox1 I would like to make a list of the Opened Workbooks and in the Listbox2 in the same form the sheets of the selected workbook in the listbox1 But also in the lisbox2 I would like to create with each sheet name a checkbox with five command buttons in the form to import, Export, Erase, Hide or Unhide the selected sheets from Wb1 to Wb2 and vice versa.
So far I receive assistance from you guys to make a do a form with a list of opened workbooks and a list of the respective worksheets here also I'm trying to get to work a code to import the sheets from one workbook to another here,. Do you know a Way to make this happen.
thank You
By the way this is the code use from a sheet to erase the sheets that might be put in the list
Sub DeleteSheets()
Dim wks As Worksheet
Dim MyRange As Range
Dim cell As Range
Set wks = Worksheets("Controls")
With wks
Set MyRange = Range("D5:D34", .Cells(.Rows.Count, "H").End(xlUp))
End With
On Error Resume Next
Application.DisplayAlerts = False
For Each cell In MyRange
Sheets(cell.Value).Delete
Next cell
Application.DisplayAlerts = True
On Error GoTo 0
Sheets("Controls").Range("D5:D34").ClearContents
End Sub
And this ones for hide and unhide the sheets:
Sub Hide_Sheets()
'In use
'Hide the sheets in Controls Sheet
Dim cell As Range
On Error Resume Next
For Each cell In Sheets("Controls").Range("E5:E34")
' Hide sheets
Sheets(cell.Value).Visible = False
Next cell
End Sub
Sub Unhide_Sheets()
'In use
'Unhide the sheets in Controls Sheet
Dim cell As Range
On Error Resume Next
For Each cell In Sheets("Controls").Range("G5:G34")
' Hide sheets
Sheets(cell.Value).Visible = True
Next cell
End Sub
I suggest the following structure of your userform:
Since you do what two lists one with workbooks and one with the worksheets of the currently selected workbook. Then you want to have five command buttons for the actions you want to perfom.
In order to update the workbooks and worksheets you will want to place code in the userform inside the Userform_activate and Listbox1_Change events. So You get the code to list all the workbook names into the listbox1 and put it into Userform_Activate. Evertime the userform is activated the list of workbooks will be updated.
If you now select a entry of listbox1 you want the code to update your sheet names. So you get the code to update the sheet names of a workbook with name "wbname" and put it into listbox1_Change. You then do the following code:
Private Sub ListBox1_Change()
Dim wbname as string
wbname=ListBox1.Value
call GetSheetNamesIntoListBox2(wbname)
End Sub
Where of course GetSheetNamesIntoListBox2 is the sub were you get all the sheetnames into ListBox2.
Lastly you need to setup the Buttons. Each Button has a Click Event which you will want to use. So if the Button is clicked the following code will run:
Private Sub CommandButton1_Click()
Dim wbname as string, wsname as string
wbname=Listbox1.Value
wsname=Listbox2.Value
' You may want to check if wbname and wsname are valid before running the Task
PerformAction(wbname,wsname)
End Sub
Where PerformAction is the routine you use to import, export, clear, hide or unhide the sheet.
I know it is no workedout solution but you will be able to adjust this general solution to your specific case. If you run into problems using my approach just ask in the comments.

VBA causing typed information to go to an incorrect worksheet

I am creating a spreadsheet that creates a reference number on the first worksheet (called database, to be used similarly to a database) and generates a new worksheet. This then gives a reference number on the new worksheet so that they are linked together. This is done by pressing "New Idea" on a UserForm.
Once this is completed it should then go to the newly created worksheet and highlight cell C7. Once this is complete it should close the UserForm and allow the user to be able to type in cell C7 on the new worksheet with no further steps needed.
This works fine if I use F8 to step through the process however if I close the code window and run through the process as a user would it doesn't work as it should.
C7 is highlighted but once you have typed in it and press enter to go to the cell below, what you've typed disappears completely, and whatever you type on the newly generated worksheet is actually entered on another worksheet.
I have a seperate worksheet that contains a button to open the UserForm and all data that is entered on the newly generated worksheet goes to this sheet incorrectly.
My code is below, and is all within the UserForm's code. I have left the ComboBox code below but this isn't relevant to the generation of the new worksheets. All that does is list the created tabs so the user can select a worksheet from the UserForm and go directly there rather than having to scroll sideways.
I'm using Excel 2013. I'm by no means a VBA veteran so any help would be greatly appreciated!
Thanks!
Private Sub UserForm_Initialize()
Me.ComboBox1.List = Worksheets("Database").Range("A2:A10000").Value
End Sub
Private Sub CreateNewIdea_Click()
CopySheet
End Sub
Sub CopySheet()
Dim LastRow As Long
NewReference
LastRow = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row - 1
ReturnValue = LastRow
Sheets("Idea Template").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = LastRow
Range("C3").Value = LastRow
Me.ComboBox1.List = Worksheets("Database").Range("A2:A10000").Value
Range("C7").Select
Unload Home
End Sub
Sub NewReference()
Dim LastRow As Long
LastRow = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row
Sheets("Database").Cells(LastRow + 1, "A").Value = Sheets("Database").Cells(LastRow, "A").Value + 1
End Sub
Private Sub ComboBox1_Change()
Worksheets(ComboBox1.Text).Select
End Sub
I've taken the liberty to edit and rewrite the code you've written for greater flexibility.
Option Explicit 'Forces the variable to be declared, undeclared variables are not allowed
Dim DatabaseTable As ListObject 'Makes the variable usable for the entire module
Dim Lastrow As Long
Private Sub UserForm_Initialize()
Set DatabaseTable = ThisWorkbook.Worksheets("Database").ListObjects("References")
'I'm assuming you've formatted the data on the worksheet as a table and named the table "References"
Dim i As Long
Dim DatabaseRows As Long
DatabaseRows = DatabaseTable.ListRows.Count
With Me.ComboBox1
.Value = Empty
.Clear
For i = 1 To DatabaseRows
.AddItem DatabaseTable.DataBodyRange(i, 1)
Next i
End With
End Sub
Private Sub CreateNewIdea_Click()
Set DatabaseTable = ThisWorkbook.Worksheets("Database").ListObjects("References")
Call CopySheet
End Sub
Sub CopySheet() 'Are you calling Sub CopySheet() from other subs besides Private Sub CreateNewIdea_Click()?
Call NewReference
Dim ReturnValue As Long 'I'm declaring this variable because I'm using the option explicit and that doesn't allow undeclared variables
ReturnValue = Lastrow 'Unless ReturnValue is a public variable, it's not doing much here.
ThisWorkbook.Worksheets("Idea Template").Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
ThisWorkbook.Worksheets("Idea Template (2)").name = Lastrow
ThisWorkbook.Worksheets(CStr(Lastrow)).Cells(1, 3).Value = Lastrow 'Cstr(lastrow) is needed because we want the sheet with the name of the last row, not the nth sheet which is what happens with WorkSheets(Lastrow) as lastrow is a number
Call UserForm_Initialize 'Calls the procedure which fills ComboBox1, if the unload home refers to this form, then this line is redundant since the combobox is filled again when the form is initialized.
ThisWorkbook.Worksheets(CStr(Lastrow)).Cells(7, 3).Select
Unload Home 'If the name of this form is home, you can just 'Unload Me'
End Sub
Sub NewReference() 'Are you calling Sub NewReference from other subs besides Sub CopySheet()?
DatabaseTable.ListRows.Add AlwaysInsert:=False 'Adds a new row to the table on the worksheet "Database"
Lastrow = DatabaseTable.ListRows.Count
If Lastrow = 2 And IsEmpty(DatabaseTable.DataBodyRange(1, 1)) Then 'This if determines if a row was added while the first row does not contain a reference
DatabaseTable.DataBodyRange(Lastrow, 1).Value = 1 'First reference, can be anything you want really
DatabaseTable.ListRows(1).Delete 'First row is deleted, otherwise you'd have an empty first row
Lastrow = Lastrow - 1
Else
DatabaseTable.DataBodyRange(Lastrow, 1).Value = DatabaseTable.DataBodyRange(Lastrow - 1, 1) + 1
End If
End Sub
Private Sub ComboBox1_Change()
If Not Me.ComboBox1 = Empty Then
Worksheets(CStr(Me.ComboBox1)).Select
End If
End Sub
Revised answer
After looking at the document provided by #tomjo and trying to reporduce the problem I found that the problem was caused by the buttons on the sheets. The buttons used were the Form Controls rather than ActiveX Controls.
A macro was assigned to the Form Control The macro was defined in a module as you'd expect. The Macro only called to show the relevant form. It appeared as if the selected sheet, either by the menu on the form or after creating a new sheet from the form wasn't properly activated and the information entered in the sheet that showing was actually entered in the form which was last manually selected. Stepping through the code I found that the proper sheet and cell was active after the selection through the form through Debug.Print ThisWorkbook.ActiveSheet.Name, ThisWorkbook.ActiveSheet.ActiveCell.Address. I failed to discover why, while the correct sheet and cell were active, the information was entered in the last manually selected worksheet and cell.
To verify that the issue was not caused by the file somehow I tried to reproduce the problem with an entirely new file. Again the problem occurred that while the screen was showing the correct sheet and cell as selected (selected through a form, called by a sub in a module, called by a Form Control) the information was actually entered in the last manually selected sheet and cell.
----Edit----
Running the Showform macro (which calls the form to show) from the Macros button under the developer tab in the ribbon, instead of clicking the Form control button which has the ShowForm macro assigned to it, doesn't create the issue.
----End of Edit----
I then only removed the Form control, and the sub in the module which calls to show the form and placed an ActiveX Control (CommandButton) on the sheet and on the relevant Sheet module created:
Private Sub CommandButton1_Click()
Form.Show
End Sub
Without editing the code any further, there were no further issues regarding information being entered on the last manually selected sheet and cell instead of the sheet and cell the screen was showing as selected.
Edited file (The link will be active for a limited time)

Listbox in Userform

I have a userform for Excel that has a listbox for employee names. I'm sourcing the options from column A of an Excel worksheet so it can auto-complete entries in the userform based on past entries. The problem is that there are multiple rows of entries in the worksheet for each employee and I would like to only have one of each names in the drop-down list.
The code to populate the listbox is:
Private Sub UserForm_Initialize()
Me.txtName.List = Worksheets("Sheet1").Range("A6:A600").Value
Is there a way to do this?
If ListBox1.Range.Value...?
The below code uses a helper Dictionary object to determine if items have been added to the ListBox, and if not, it adds them. It also dynamically selects the range of names based on a starting cell of A6 and moving down the spreadsheet to the first break in data. If there are breaks that you want to ignore, please let us know.
I used the AddItem method of the ListBox instead of the List property.
Private Sub UserForm_Initialize()
Dim rNames As Range
Dim oDict As Object
Dim cel As Range
Set rNames = Worksheets("Sheet1").Range("A6:A" & Worksheets("Sheet1").Range("A6").End(xlDown).Row)
Set oDict = CreateObject("Scripting.Dictionary")
For Each cel In rNames
If oDict.exists(cel.Value) Then
'Do nothing for now
Else
oDict.Add cel.Value, 0
Me.txtName.AddItem cel.Value
End If
Next cel
End Sub