Replace cell values in specific sheets with defined name - vba

I am trying to run some code that replaces the cell values in a specific column with a defined name. In addition, I have a condition that the replacement should only take place if the first 9 characters of the values are xxxxxxxxx.
More precisely, it should change the values in C:C in 2 specific worksheets (I don't want to loop through the whole workbook).
I am not sure why nothing happens in the code (no error messages, nothing).
I presume, however, that I should not use With if I want the code to work in these 2 specific worksheets. I am also aware that my use of Range is probably not totally correct.
Sub ChangeMe()
Dim cl As Range
For Each cl In Worksheets("Sheet1").Range("C:C").End(xlUp)
With Worksheets("Sheet2").Range("C:C").End(xlUp)
If Left(cl.Value, 9) = "XXXXXXXXX" Then
cl.Value = ThisWorkbook.Names("MyDefinedName").RefersToRange
End If
End With
Next cl
End Sub

In answer your original questions:
I am not sure why nothing happens in the code (no error messages, nothing).
Nothing happens because your worksheet values are lowercase xxxxxxxxx, whilst your code checks for uppercase XXXXXXXXX.
I presume, however, that I should not use With if I want the code to work in these 2 specific worksheets.
Actually, you can use With with multiple sheets, as I will demonstrate below.
I am also aware that my use of Range is probably not totally correct.
That is true. If you were to fix the uppercase issue, only C1 would be changed. This is because .End() works on a single cell. If you supply a multi-cell range, it uses the top left most cell. So .Range("C:C").End(xlUp) is equivalent to .Range("C1").End(xlUp) which evaluates to just C1.
The following will answer your updated question:
Option Explicit
Public Sub ChangeMe()
Const l_xxxxxxxxx As String = "xxxxxxxxx"
Const l_MyDefinedName As String = "MyDefinedName"
Const s_Delimiter As String = ","
Const s_WorkSheetNames As String = "Sheet1,Sheet2"
Const s_ColumnToChange As String = "C:C"
Dim varWorkSheetName As Variant
For Each varWorkSheetName In Split(s_WorkSheetNames, s_Delimiter)
With Worksheets(varWorkSheetName).Range(s_ColumnToChange)
Dim rngCell As Range
For Each rngCell In .Resize(.Cells(Rows.Count).End(xlUp).Row)
With rngCell
Dim strCellValue As String: strCellValue = .Value2
If Left(strCellValue, Len(l_xxxxxxxxx)) = l_xxxxxxxxx Then
.Value2 _
= Names(l_MyDefinedName).RefersToRange.Value2 _
& Right$(strCellValue, Len(strCellValue) - Len(l_xxxxxxxxx))
End If
End With
Next rngCell
End With
Next varWorkSheetName
End Sub
Notes:
It is a good idea to use constants so all literal values are typed once only and kept grouped together.
Using .Value2, instead of .Value, is the recommended way to access a cell's value as it avoids implicit casting and is therefore faster. (Using .Value can also sometimes cause issues.)
Surprisingly, in VBA there are good reasons to put a variable declaration as close as possible to the first use of the variable. Two such reasons are 1) it improves readability, and 2) it simplifies future refactoring. Just remember that the variable is not reinitialised every time the Dim is encountered. Initialisation only occurs the first time.

If I understood your post correctly (which I doubt it), I think you want to loop through column "C" in both "Sheet1" and "Sheet2". Every cell that starts with 9 "XXXXXXXXX", should be replaced with the value in "MyDefinedName" Named Range.
Code
Option Explicit
Sub ChangeMe()
Dim cl As Range
Dim sht As Worksheet
For Each sht In ThisWorkbook.Sheets
With sht
If .Name = "Sheet1" Or .Name = "Sheet2" Then
For Each cl In .Range("C1:C" & .Cells(.rows.Count, "C").End(xlUp).Row)
If Left(cl.Value, 9) = "XXXXXXXXX" Then
cl.Value = ThisWorkbook.Names("MyDefinedName").RefersToRange
End If
Next cl
End If
End With
Next sht
End Sub

Let's imagine that this is your input:
In this case, you want to change the values in range A1:A2 to the value in C1 (named range xxxx123), because it starts with xxxx123. This is the code to achieve it:
Public Sub TestMe()
Dim myCell As Range
Dim myNamedRange As String
myNamedRange = "xxxx123"
For Each myCell In Range("A1:A2")
If Left(myCell, Len(myNamedRange)) = myNamedRange Then
myCell.Value = Range(myNamedRange)
End If
Next myCell
End Sub

Related

Substitute Excel Formula Argument (provided by the user) with a Variable

Concept:
Entire Rows are deleted through a macro based off parameters which are represented as an excel formula by the user. The idea here is that a user can use Boolean formulas that they're already familiar with to evaluate values in a range (read the "Process" below for further clarification).
Process:
A user clicks on a button which shows a form. This form contains two input fields (or parameters); "Column" and "Formula". The "Column" is the range for which the macro will be cycling through (let's say $A:$A). The "Formula" is an Excel based formula represented as such, in the user parameter field ie =OR(A1="X",A1="Y"). However, I've instructed the user to replace any instance of A1 with rng. I've requested the user to do this because the idea here is that I would replace rng with a changing variable in VBA that cycles through all the cells specified in the "Column" parameter.
Problem:
I'm not aware of any way to replace the rng representation within the Excel formula with a range variable in VBA.
Update 4-7-17
Thank you all for your responses but I'm pretty certain my problem is getting lost in translation. I'm aware this is my fault, since I didn't provide any code for analysis. Unfortunately, therein lies the issue. I don't know what to write. I'm going to do my best to write some code (that I know is wrong) which will hopefully convey what I'm trying to accomplish.
Sample Code 4-7-17
Sub SampleCode()
Dim wRng As Range
Set wRng = Range("A1:A26") 'Let's assume that the values in this range are the
' letters of the alphabet
Dim Counter As Integer
'Cell "B2" will contain a formula that the user has entered
'which is: =OR(rng="X",rng="M")
'Obviously the formula returns an error in excel (#NAME? to be
'exact) but that's understood.
Dim wFormula As String
wFormula = Range("B2").Formula
Dim rng As Range 'This variable "rng" is what is represented in the
'formula that was written in Range("B2")
'*** This is where I get stuck. I know I'm missing code here to
'be able to proceed with my routine below.
'code
'code
'code
Counter = wRng.Rows.Count
For i = 1 To wRng.Rows.Count
Set rng = Cells(Counter, 1)
If wFormula = True Then
rng.EntireRow.Delete
End If
Counter = Counter - 1
Next i
'The ending result should be that row 24 was deleted because it contained
'the letter "X" and row 13 was deleted because it contained the letter "M"
'
'The objective of this code is to use any Excel formula which evaluates out
'to a True or False value.
End Sub
Hey Jon first you need to declare a Variable of relevant data type, then pass value from Range & finally use where you wish to, like,
Dim Src As Variant
Src= Sheets( "Sheet3" ).Range( "A2:A9" ).Value
Hey John this code will help you to get the solution,
Public Sub ProcessData()
Const TEST_COLUMN As String = "A"
Dim Lastrow As Long Dim i As Long
Application.ScreenUpdating = False
With ActiveSheet
Lastrow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = Lastrow To 1 Step -1
If Cells(i, TEST_COLUMN).Value2 Like "AU" Or _ Cells(i, TEST_COLUMN).Value2 Like "AZ" Then
.Rows(i).Delete
End If
Next i
End With
Application.ScreenUpdating = True
End Sub

Setting variables VBA

complete novice here
I started some VBA a few days ago, I have simple question but cant seem to find what I am doing wrong.
I am trying to make a button which will take the coordinates of the active cell and compare them to another worksheet to retrieve a specific value from another table.
I set variables to the active cell column and row, I want to do this so I can later compare these locations to another worksheet and get the value at a specified position on another worksheet.
So far I have written simply what I could find on the internet as I have no formal training.
The msgbox at the end is just to test whether or not it actually picks up the reference.
Sub CommandButton1_Click()
Dim Arow As Range
Dim Acol As Range
Set Arow = Worksheets("Sheet1").Range(ActiveCell.Row)
Set Acol = Worksheets("Sheet1").Range(ActiveCell.Column)
MsgBox (Arow)
End Sub
So far I have error run-time error '1004' Application defined or object defined error highlighting the 4th Row. If anyone could help me solve this or redirect me to some help it would be much appreciated.
I think this won't work, you should put there
Set arow = Worksheets("Sheet1").Range(ActiveCell.Row & ":" & ActiveCell.Row)
Putting there simply number won't work. For the column, you should put there somethong like C:C. For getting letter of column, see this qestion: Function to convert column number to letter?
For more information about Range property, please see official documentation https://msdn.microsoft.com/en-us/library/office/ff836512.aspx.
The thing is, that you have to supply either the address in so called A1 reference, which is "A1", or "$A$1" or name of cell, etc, or you have to supply two Range objects, such as two cells Worksheets("Sheet1").Range(Worksheets("Sheet1").Cells(1,1), Worksheets("Sheet1").Cells(2,2)), which defines area starting with upper-left corner in first parameter and lower right in second parameter.
ActiveCell.Row and ActiveCell.Column returns you some Integer value representing number of row and column, i.e. if you point cell B4, ActiveCell.Row would return 4, and ActiveCell.Column gonna return 2. An Range() property need as an argument whole adress for some range, i.e. Range("C6") or Range("G3:J8").
When you have your column as a number, you can use Cells() property for pointing first and last cell in your range, i.e. Range(Cells(2, 4), Cells(6, 8) would be the same range as Range("D2:H6").
Following this, one of the ways that you can do what you have described is:
Sub CommandButton1_Click()
Dim Rng As Range
Set Rng = Worksheets("Sheet1").Cells(ActiveCell.Row, ActiveCell.Column)
End Sub
Now you have under variable Rng an Range of the same coordinates as ActiveCell, but in Sheet1. You can pass some value into i.e Rng.Value = "Hello World", paste something with Rng.PasteSpecial xlPasteAll etc.
if you want the value from other sheet at the same location as activeCell, use this code,
Private Sub CommandButton1_Click()
valueFromOtherSheet = Sheets("Sheet2").Range(ActiveCell.Address)
MsgBox (valueFromOtherSheet)
End Sub
Like the others have said, it's just about knowing your variable types. This is another way you could achieve what you want
Sub CommandButton1_Click()
Dim Acell As Range
Set Acell = Worksheets("Sheet2").Range(ActiveCell.Address)
MsgBox "Value on ActiveSheet: " & ActiveCell.Value & vbNewLine & _
"Value on Sheet2: " & Acell.Value
End Sub
Thank you everyone for the help and clarification, In the end I was able to come up with some code that seems to do what I need it to.
Private Sub CommandButton1_Click()
Dim cabDate As Range
Dim searchCol As Integer
Dim newindex As Range
Set cabDate = WorksheetFunction.Index(Range("A1:O9999"), ActiveCell.Row, 2)
searchCol = ActiveCell.Column
Set newindex = WorksheetFunction.Index(Worksheets("Deadlines").Range("A1:O9999"), cabDate.Row, searchCol)
MsgBox (newindex)
End Sub
I wasn't aware about conflicting data types so thank you all for the assistance.

Subscript out of range

I'm reaching out because on a works system computer I get run-time errors on basic macros (Excel 2010) Windows Operating System. These errors don't occur on my home Excel 2010, or 2016 systems. I should NOT be getting subscript out of range errors when performing the code in new files.
I wrote these on my own computer without any problems.
Option Explicit
Sub MoveDataOtherSheets()
With Excel.ThisWorkbook.Sheets("Sheet3")
Dim cell
For Each cell In .Range(.Cells(2, 1), Cells(.Rows.Count, 1).End(Excel.xlUp))
If cell(1, 1) = "PERSONAL" Then
With Excel.ThisWorkbook.Sheets("Sheet4")
cell.EntireRow.Copy .Cells(.Rows.Count, 1).End(Excel.xlUp)(2, 1)
End With
End If
If cell(1, 1) = "COMPANY" Then
With Excel.ThisWorkbook.Sheets("Sheet5")
cell.EntireRow.Copy .Cells(.Rows.Count, 1).End(Excel.xlUp)(2, 1)
End With
End If
Next
End With
End Sub
As I commented I think the only possible causes of that error are:
any of the worksheet names you are using is not valid for the actual workbook the running macro resides in (which is ThisWorkbook exactly)
the missing dot in the 2nd occurrence of Cells in For Each cell In .Range(.Cells(2, 1), Cells(.Rows.Count, 1).End(Excel.xlUp)) statements
thus while all other references (.Range and .Cells) are parented to the object after the last With keyword, the simple Cells(.Rows.Count, 1) actually refers to the currently active worksheet column 1 last row
but I mostly wrote this answer to propose you some refactoring of your code:
Option Explicit
Sub MoveDataOtherSheets()
Dim cell As Range, dataRng As Range
Dim shtName As String
With Excel.ThisWorkbook
Set dataRng = SetDataRng(.Worksheets("Sheet3"), 1)
For Each cell In dataRng
shtName = GetSheetName(cell)
If shtName <> "" Then CopyRow cell, .Sheets(shtName)
Next cell
End With
End Sub
Sub CopyRow(cell As Range, sht As Worksheet)
With sht
cell.EntireRow.Copy .Cells(.Rows.Count, 1).End(Excel.xlUp)(2, 1)
End With
End Sub
Function SetDataRng(sht As Worksheet, colIndex As Long) As Range
With sht
Set SetDataRng = .Range(.Cells(2, colIndex), .Cells(.Rows.Count, colIndex).End(Excel.xlUp))
End With
End Function
Function GetSheetName(cell As Range) As String
Select Case cell
Case "PERSONAL"
GetSheetName = "Sheet4"
Case "COMPANY"
GetSheetName = "Sheet5"
Case Else
GetSheetName = ""
End Select
End Function
which takes the move from the following considerations:
it's preferable not to nest With blocks referring not correlatives objects
in
With Excel.ThisWorkbook.Sheets("Sheet3")
...
With Excel.ThisWorkbook.Sheets("Sheet4")
you're nesting two not-parented With objects, thus breaking a sane With "chain" like could be the following:
With Excel.ThisWorkbook
With .Sheets("Sheet3")
...
End With
With .Sheets("Sheet4")
...
End With
End With
I'm not telling you exactly why this "chain" breaking is insane since I learned it quite a long time ago but can't recall now (!), but it has to do with memory management
avoid putting into With blocks code that doesn't use the referenced object
like that Dim cell was
those two If blocks are clearly mutually exclusive: a cell value can't equal "PERSONAL" and "COMPANY" at the same time!
so the correct If block would be:
If cell(1, 1) = "PERSONAL" Then
....
ElseIf cell(1, 1) = "COMPANY" Then
...
End If
but at this point I'd suggest you to switch to the Select Case block construct, which is more suitable for further code branching (should more comparing values arise) and more readable
it's a good coding habit to demand specific tasks to dedicated Functions/Subs
this holds true even if these tasks are up to now simple and short coded, since the code will always grow and quickly become cluttered and hardly comprehensible and maintanable
both the refactoring reasons and the refactored coded are a contribution of mine and are much likely to be improved
but they can be a good starting point

Select Method of Worksheet Class Failed

I have this sub in Excel 2010 which is supposed to filter through all the cells in a sheet until it finds a match to Proj No, then paste a field from this row into another field.
When I try to run the sub, it gives me an error 1004: Select Method of Worksheet Class Failed. I've marked the line where this occurs. Any assistance would be greatly appreciated.
Option Explicit
Private Sub btnNext_Click()
Dim ProjNo As String
Dim Col As String
Dim Row As String
Dim cell As Range
Unload Dialog
formWait.Show
Sheets("Sheet7").Activate
ProjNo = Worksheets("Sheet1").Range("D6").Value
Col = Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In Range("A2:A" & Col) 
If cell.Value = ProjNo Then
Row = Row & cell.Row
End If
Next cell
Workbooks("Form.xlsm").Sheets("Sheet7").Range("Row, 6").Copy Destination:=Sheets("Sheet1").Range("19, 5") ‘Error
Unload formWait
End Sub
I don't know what GWP is, but I think you want to use ProjNo there. The Range property doesn't accept an argument like that. Unless you have a named range of "Row,6" which you don't because it's not a legal name, you have to supply Range with a valid range reference, like A6 or D2:D12, for example.
Also, you can't concatenate rows and use them in a Range reference to get a larger range. You would have to copy each row inside the loop, union the ranges as you go, or better yet, filter on the value that you want and copy the visible rows.
Try this:
Private Sub btnNext_Click()
With ThisWorkbook.Worksheets("Sheet7")
'filter for the project id
.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 6).AutoFilter 1, "=" & .Range("D6").Value
'copy the visible rows
.Range("F2", .Cells(.Rows.Count, 6).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
ThisWorkbook.Worksheets("Sheet1").Cells(19, 5)
'get rid of the filter
.AutoFilterMode = False
End With
End Sub
There are a few confusing items in your code above, so I wanted to place them long-form here. Let's get started:
Dim Col As String
Dim Row As String
It looks like your design expects these to be of type Long rather than type String. Even if these variables were meant to be strings, I would recommend adjusting their names -- when your fellow developer attempts to review your design, he or she is likely to see names like "Col" or "Row" and think "these are numbers". Easy fix:
Dim Col As Long, Row As Long
The next issue comes up here:
Col = Cells(Rows.Count, "A").End(xlUp).Row
The structure above is a common method for identifying the last ROW, not column. (It also appears that you have switched the "A" and number, which is another easy fix). While it is perfectly acceptable syntactically to name the variable for last row "Col", human users are likely to find this confusing. Identifying the last row (and the last col, which you use in the For Each loop), as explained in fantastic detail here, would be better handled like this:
Dim SheetSeven As Worksheet, SheetOne As Worksheet
Dim LastRow As Long, LastCol As Long
Set SheetSeven = ThisWorkbook.Worksheets("Sheet7")
Set SheetOne = ThisWorkbook.Worksheets("Sheet1")
With SheetSeven
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
LastCol = .Range("A" & .Columns.Count).End(xlToLeft).Column
End With
This should make your For Each loop look like this:
With SheetSeven
For Each cell in .Range("A2:A" & LastCol)
'... do you comparison and row incrementing here
Next cell
End With
Once you've identified your sheet as a variable, the Range.Copy action should be much easier as well:
With SheetSeven
.Range(.Cells(Row, 6)).Copy _
Destination:=SheetOne.Range(SheetOne.Cells(19, 5))
End With
Also one other thing you may wish to check is the status of Application.ScreenUpdating.
With the release of Office 2013 and later, a SDI (Single Document Interface) was introduced. If Application.ScreenUpdating is False and the workbook is not active, the implied call to Workbook.Activate will fail. Check the status of ScreenUpdating and set it to True if needed. You can set it back to False after the first Activate call for that workbook is made.
See this article:
https://support.microsoft.com/en-us/help/3083825/excel-workbook-is-not-activated-when-you-run-a-macro-that-calls-the-wo
In my case the error came as the sheet was hidden.
so I check if I am not working with the hidden sheet. Or you need to unhide the sheet before you try to select or activate sheet.
For Each sh In ThisWorkbook.Sheets
If Left(sh.Name, 8) <> "Template" Then
sh.Select
sh.Range("A1").Select
End If
Next

Type Mismatch Error after MsgBox

my data is as below .
Updated Question
Sub Solution()
Dim shData As Worksheet
Set shData = Sheets("Sheet1") 'or other reference to data sheet
Dim coll As Collection, r As Range, j As Long
Dim myArr As Variant
Dim shNew As Worksheet
shData.Activate
'get unique values based on Excel features
Range("a1").AutoFilter
Set coll = New Collection
On Error Resume Next
For Each r In Range("A1:A10")
coll.Add r.Value, r.Value
Next r
On Error GoTo 0
'Debug.Print coll.Count
For j = 1 To coll.Count
MsgBox coll(j)
myArr = coll(j)
Next j
Range("a1").AutoFilter
Dim i As Long
For i = 0 To UBound(myArr)
shData.Range("$A$1").AutoFilter Field:=1, Criteria1:=myArr(i), _
Operator:=xlAnd
On Error Resume Next
Sheets(myArr(i)).Range("A1").CurrentRegion.ClearContents
If Err.Number = 0 Then
Range("A1").CurrentRegion.Copy Sheets(myArr(i)).Range("A1")
Else
Set shNew = Sheets.Add(After:=Sheets(Sheets.Count))
shData.Range("A1").CurrentRegion.Copy shNew.Range("A1")
shNew.Name = myArr(i)
Err.Clear
End If
Next i
'removing filter in master sheet
shData.Range("a1").AutoFilter
End Sub
When I run above macro I don't know why it is giving Type Mismatch Error after MsgBox coll(j) , simply I want to store data in Array and I'm passing that data , Here I am using For Each r In Range("A1:A10") Where A10 length is static how can I find last written column?
When you add something to collection the key needs to be a string so use:
coll.Add r.Value, CStr(r.Value)
instead of:
coll.Add r.Value, r.Value
You are still assigning coll(j) to a Variant which is not an array.
You need to:
ReDim myArr(1 to coll.Count)
Before your for loop and then in the loop:
myArr(j) = coll(j)
Before attempting to respond to this question, I would like to write what I believe you are trying to accomplish; when you confirm this is what you are trying to do, I will try to help you get working code to achieve it. This would normally be done with comments, but the threads of comments so far are a bit disjointed, and the code is quite complex...
You have data in a sheet (called "sheet1" - it might be something else though)
The first column contains certain values that might be repeated
You don't know how many columns there might be... you would like to know that though
You attempt to find each unique value in column A (call it the "key value"), and display it (one at a time) in a message box. This looks more like a debug step than actual functionality for the final program.
You then turn on the autofilter on column A; selecting only rows that match a certain value
Using that same value as the name of a sheet, you see if such a sheet exists: if it does, you clear its contents; if it does not, then you create it at the end of the workbook (and give it the name of the key)
You select all rows with the same (key) value in column A on sheet1, and copy them to the sheet whose name is equal to the value in column A that you filtered on
You want to repeat step 5-8 for each of the unique (key) values in column A
When all is done, I believe you have (at least) one more sheet than you had key values in column A (you also have the initial data sheet); however you do not delete any "superfluous" sheets (with other names). Each sheet will have only rows of data corresponding to the current contents of sheet1 (any earlier data was deleted).
During the operation you turn autofiltering on and off; you want to end up with auto filter disabled.
Please confirm that this is indeed what you are attempting to do. If you could give an idea of the format of the values in column A, that would be helpful. I suspect that some things could be done rather more efficiently than you are currently doing them. Finally I do wonder whether the whole purpose of organizing your data in this way might be to organize the data in a specific way, and maybe do further calculations / graphs etc. There are all kinds of functions built in to excel (VBA) to make the job of data extraction easier - it's rare that this kind of data rearranging is necessary to get a particular job done. If you would care to comment on that...
The following code does all the above. Note the use for For Each, and functions / subroutines to take care of certain tasks (unique, createOrClear, and worksheetExists). This makes the top level code much easier to read and understand. Also note that the error trapping is confined to just a small section where we check if a worksheet exists - for me it ran without problems; if any errors occur, just let me know what was in the worksheet since that might affect what happens (for example, if a cell in column A contains a character not allowed in a sheet name, like /\! etc. Also note that your code was deleting "CurrentRegion". Depending on what you are trying to achieve, "UsedRange" might be better...
Option Explicit
Sub Solution()
Dim shData As Worksheet
Dim nameRange As Range
Dim r As Range, c As Range, A1c As Range, s As String
Dim uniqueNames As Variant, v As Variant
Set shData = Sheets("Sheet1") ' sheet with source data
Set A1c = shData.[A1] ' first cell of data range - referred to a lot...
Set nameRange = Range(A1c, A1c.End(xlDown)) ' find all the contiguous cells in the range
' find the unique values: using custom function
' omit second parameter to suppress dialog
uniqueNames = unique(nameRange, True)
Application.ScreenUpdating = False ' no need for flashing screen...
' check if sheet with each name exists, or create it:
createOrClear uniqueNames
' filter on each value in turn, and copy to corresponding sheet:
For Each v In uniqueNames
A1c.AutoFilter Field:=1, Criteria1:=v, _
Operator:=xlAnd
A1c.CurrentRegion.Copy Sheets(v).[A1]
Next v
' turn auto filter off
A1c.AutoFilter
' and screen updating on
Application.ScreenUpdating = True
End Sub
Function unique(r As Range, Optional show)
' return a variant array containing unique values in range
' optionally present dialog with values found
' inspired by http://stackoverflow.com/questions/3017852/vba-get-unique-values-from-array
Dim d As Object
Dim c As Range
Dim s As String
Dim v As Variant
If IsMissing(show) Then show = False
Set d = CreateObject("Scripting.Dictionary")
' dictionary object will create unique keys
' have to make it case-insensitive
' as sheet names and autofilter are case insensitive
For Each c In r
d(LCase("" & c.Value)) = c.Value
Next c
' the Keys() contain unique values:
unique = d.Keys()
' optionally, show results:
If show Then
' for debug, show the list of unique elements:
s = ""
For Each v In d.Keys
s = s & vbNewLine & v
Next v
MsgBox "unique elements: " & s
End If
End Function
Sub createOrClear(names)
Dim n As Variant
Dim s As String
Dim NewSheet As Worksheet
' loop through list: add new sheets, or delete content
For Each n In names
s = "" & n ' convert to string
If worksheetExists(s) Then
Sheets(s).[A1].CurrentRegion.Clear ' UsedRange might be better...?
Else
With ActiveWorkbook.Sheets
Set NewSheet = .Add(after:=Sheets(.Count))
NewSheet.Name = s
End With
End If
Next n
End Sub
Function worksheetExists(wsName)
' adapted from http://www.mrexcel.com/forum/excel-questions/3228-visual-basic-applications-check-if-worksheet-exists.html
worksheetExists = False
On Error Resume Next
worksheetExists = (Sheets(wsName).Name <> "")
On Error GoTo 0
End Function