Efficiency through functions, I am lost - vba

I struggle with VBA - I tend to write as though I am the Macro Recorder and as a result write really ugly macros and end up making things far more complicated than needs be.
Can you possibly have a look and help identify some efficiencies? I want to learn to write good code, but need to compare and contrast and its hard from looking at other peoples examples.
Sub ColumnSearch()
'Filepath variables - the filename changes daily but always contains the name notifications, this seemed to be the easiest method
Dim filepath As String
filepath = ActiveWorkbook.Path + "\"
Application.ScreenUpdating = False
Dim file As String
Dim fullfilepath As String
file = Dir$(filepath & "*Notifications*" & ".*")
fullfilepath = filepath & file
Application.EnableEvents = False
Workbooks.Open (fullfilepath)
Windows(file).Activate
Application.EnableEvents = True
'variables set as string and range respetively
Dim strDoN As String, strOffice As String, strARN As String, strPIN As String, strAN As String, strAT As String, strSoS As String
Dim rngDoN As Range, rngOffice As Range, rngARN As Range, rngPIN As Range, rngAN As Range, rngAT As Range, rngSoS As Range
Dim rng2DoN As Range, rng2Office As Range, rng2ARN As Range, rng2PIN As Range, rng2AN As Range, rng2AT As Range, rng2SoS As Range
Dim myRange As Range
Dim NumCols, i As Integer
'str variables set as the text in row 1 (title cells)
strDoN = "Date of Notification"
strOffice = "Office Centre"
strARN = "Appeal Reference Number"
strPIN = "PIN"
strAN = "Appellant Name"
strAT = "Appeal Type"
strSoS = "SoS Decision Date"
Sheets("New Appeals").Activate
'For loop to find the address of the strings above
For i = 1 To 11
Select Case Cells(1, i).Value
Case strDoN
Set rngDoN = Cells(1, i) '
Case strOffice
Set rngOffice = Cells(1, i)
Case strARN
Set rngARN = Cells(1, i)
Case strPIN
Set rngPIN = Cells(1, i)
Case strAN
Set rngAN = Cells(1, i)
Case strAT
Set rngAT = Cells(1, i)
Case strSoS
Set rngSoS = Cells(1, i)
Case Else
'no match - do nothing
End Select
Next i
'Identify the count of cells to be copied from one sheet to the other
RowLast = Cells(Rows.Count, rngOffice.Column).End(xlUp).Row
Cells(RowLast - 1, rngOffice.Column).Select
Range(Selection, Selection.End(xlUp)).Offset(1, 0).Copy
'activate the other workbook, run the same search for loop but with rng2 being set (rng and rng2 can be different as there are sometimes extra columns that are not required
Workbooks("Book2.xlsm").Activate
Sheets("New Appeals").Select
For i = 1 To 11
Select Case Cells(1, i).Value
Case strDoN
Set rng2DoN = Cells(1, i) '<~~ set the range object to this cell
Case strOffice
Set rng2Office = Cells(1, i)
Case strARN
Set rng2ARN = Cells(1, i)
Case strPIN
Set rng2PIN = Cells(1, i)
Case strAN
Set rng2AN = Cells(1, i)
Case strAT
Set rng2AT = Cells(1, i)
Case strSoS
Set rng2SoS = Cells(1, i)
Case Else
'no match - do nothing
End Select
Next i
Dim RowLast2 As Long
'find the last cell that was updated (every day the list will grow, it has to be pasted at the bottom of the last update)
RowLast2 = Cells(Rows.Count, rng2Office.Column).End(xlUp).Row
Cells(RowLast2, rng2Office.Column).Offset(1, 0).Select
Selection.PasteSpecial
Workbooks(file).Activate
Sheets("New Appeals").Select
'start from scratch again but with the next variable etc
RowLast = Cells(Rows.Count, rngARN.Column).End(xlUp).Row
Cells(RowLast - 1, rngARN.Column).Select
Range(Selection, Selection.End(xlUp)).Offset(1, 0).Copy
Workbooks("Book2.xlsm").Activate
Sheets("New Appeals").Select
RowLast2 = Cells(Rows.Count, rng2ARN.Column).End(xlUp).Row
Cells(RowLast2, rng2ARN.Column).Offset(1, 0).Select
Selection.PasteSpecial
Workbooks(file).Activate
Sheets("New Appeals").Select
End Sub
If this is inapropriate let me know and I'll delete it if needed!

I would consider the following:
Macro description: The comments below the subroutine header should be concise and explain what the macro does, if it is not clear from its name. Your subroutine searches columns. You might want to include what is searched, i.e., "searches a predefined set of strings, selects [...] and copies from [...] to [...]. I would avoid details such as "this seemed to be the easiest method".
Notation / Variable names: It is good practice to give consistent names to your variables. In VBA CamelCase is commonplace. Also, prepending the object type in the variable name is very common, i.e., strDoN as String. If you do so though, make sure you do it everywhere (so filepath should be strFilePath). See here for the naming conventions.
Type declaration: Place all Dim statements at the beginning of the subroutine.
Events: Be careful with enabling and disabling events. If you disable events they won't be re-enabled automatically, so in case of an error (exception) there should be additional actions that re-enable the events. See this post for details on error handling.
As Chris Neilsen mentioned in the comments, avoid using Select and Activate.
Proper Dim-ing: When you do Dim NumCols, i as Integer you actually do Dim NumCols as Variant, i as Integer. If you want both of them to be integers, use Dim Numcols as Integer, i as Integer. Also, prefer Long to Integer.
Explicit Declarations: Put Option Explicit on top of your modules/worksheets. This means that every variable that is used should have been declared first (with a Dim statement). This is useful to avoid bugs from typos, and to have all your variables defined in a single place. Some of your variables, such as RowLast are not defined explicitly now, and they are of Variant type, while their type could had been more specific.
Avoid hardcoding: It is good practice to not refer explicitly to whatever the user can change in a worksheet. Example: Sheets("New Appeals").Activate will work if the sheet name is New Appeals, but if the user changes the name, it will break. Use the sheet's ID instead. Similarly, in your code you assign string variables to hardcoded strings ("Date of Notification", etc). It is safer if you design an area in your sheet from where you can pull this data every time.
Dealing with lots of Cases: the best solution is to use a Dictionary object. It is more elegant, and the code is less cluttered. An example is here.
Copying and Pasting: Use the Range.Copy and Range.PasteSpecial Methods instead of the Selection ones. also, it is not always necessary to Activate a sheet in order to copy/paste there. The Range object can do useful stuff (searching, specialcells, etc.). Check it out.
Fully qualify Ranges: When you copy-paste data from different sheets/files, always use the full name of your Range/Cells objects, to avoid bugs. Relevant SO post here.
Dealing with Large Ranges: Passing data between Excel and VBA can be time-consuming when the numbers get bigger. A good practice is to pass the excel data to a Variant Array, do whatever processing and then dump them back to excel. This is a good read.
Use of With blocks: When you refer to an object's properties/methods multiple times, it enhances readability. Example here.
I hope this helps. This is by not means an exhaustive list, but it might be useful to start with. Happy coding!

Related

Excel VBA macro type mismatch error

I found out that an office at my work spent weeks manually going through an Excel spreadsheet containing a database with >500,000 rows looking for duplicate rows matching certain criteria. The duplicates could not simply be erased before being researched, as a single mistake could have potentially lost hundreds of thousands of dollars in lost production. I decided simply flagging them and referencing the originating row would be the best answer in this case. So I decided to look into macros to see how much time could have been saved by using a simple macro instead. I am using this as a programming learning experience, so please no "here's a =function()" answers.
I've written a macro and changed it several times to no avail (most current is below). I wanted to use String variables because there's no telling what has been entered into the cells that will be checked. Here's what I've tried, failed, and learned(?) from this site:
Initially, I tried declaring a variable, and attaching a value from a cell directly to it. e.g. Dim myString As String Set myString = Cells(x, x).Value However, I kept getting object errors. Thanks to Michael's response here, I learned that you have to use the Range variable to use Set.
My next issue has been getting a "type mismatch" error. I'm trying to assign and compare a stored variable against another stored variable, and I'm sure this is causing the issue. I initially tried Dim myRange As Range, myString As String Set myRange = Cells(x, x).Value myString = myRange. This obviously didn't work, so I tried using the CStr() "change to string" function to convert the Range variable to the String variable I want. And that's where I'm stuck.
Sub Duplicate()
'Declare the variables
Dim NSNrange, PNrange, KitIDrange As Range
Dim NSN, PN, KitID As String
Dim NSNCheck, PNCheck, KitIDCheck As String
Dim i, j, printColumn, rowCount As Integer
'Set which column we want to print duplicates on, and count the number of rows used
rowCount = ActiveSheet.UsedRange.Rows.Count
printColumn = 9
'Lets get started!
'Clear the duplicate list column for a fresh start
Columns(printColumn).EntireColumn.Delete
'Start on line 2, and grab the cell values for the NSN, Part number and kit ID.
For i = 2 To rowCount
Set NSNrange = Cells(i, 5).Value
Set PNrange = Cells(i, 7).Value
Set KitIDrange = Cells(i, 2).Value
'Change whatever is contained in those cells into a string and store them into their respective containers
NSN = CStr(NSNrange)
PN = CStr(PNrange)
KitID = CStr(KitIDrange)
'Now let's look through the rest of the sheet and find any others that match the 3 variables that we stored above
For j = 2 To rowCount
'To avoid needless checks, we'll check to see if it's already had a duplicate found. If so, we'll just skip to the next row
If Cells(j, printColumn).Value = "" Then
'If the print column is blank, we'll grab the 3 values from the current row to compare against the above variables
Set NSNrange = Cells(j, 5).Value
Set PNrange = Cells(j, 7).Value
Set KitIDrange = Cells(j, 2).Value
'Now we store the contents into their very own container
NSNCheck = CStr(NSNrange)
PNCheck = CStr(PNrange)
KitIDCheck = CStr(KitIDrange)
'Check the initial row with the current row to see if the contents match. If so, print which row it is duplicated on.
If NSN = NSNCheck And PN = PNCheck And KitID = KitIDCheck Then Cells(j, printColumn).Value = "Duplicated on row " & i
End If
Next j
Next i
MsgBox "Search Complete"
End Sub
As you asked for comments in relation to type errors. There are a number of place where confusion could arise
1) Every line where you do multiple declarations on the same line like this:
Dim NSNrange, PNrange, KitIDrange As Range
Only the last variable is explicitly type declared (in this case as a Range). The others are implicit Variant. So, I have gone through and put on separate lines and declared them as I believe you may have meant them to be.
2) Using Activesheet and, in other places, just Cells or Range, which implicitly references the Activesheet, means if you have changed sheets by then you may longer be referring to the sheet you intended. So whilst I have kept Activesheet in, and used an overarching With Activesheet statement that then allows me to say .Cells or .Range etc, you should change this to using explicit sheet names.
3) Where ever you use the Set keyword the expectation is your are working with an object (e.g. a Range). Going by your naming convention I am going to say that you mean
Set NSNrange = Cells(i, 5)
when you say
Set NSNrange = Cells(i, 5).Value
Which sets a range to another range rather than a cell value.
4) I have changed your Integers to Longs. You are working with rows which can go beyond what Integer type can handle so you risked overflow. Long is safer.
5) Rather than doing a conversion on the Range as follows
NSN = CStr(NSNrange)
Where the default property of the range, .Value, will be taken, as you want a string you can drop the CStr conversion and just take the .Text property which will give you the string you want.
6) Rather than the empty string literal "" comparison, I have used vbNullString which is faster to assign and to check.
Option Explicit
Sub Duplicate()
Dim NSNrange As Range
Dim PNrange As Range
Dim KitIDrange As Range
Dim NSN As String
Dim PN As String
Dim KitID As String
Dim NSNCheck As String
Dim PNCheck As String
Dim KitIDCheck As String
Dim i As Long
Dim j As Long
Dim printColumn As Long
Dim rowCount As Long
With ActiveSheet
rowCount = .UsedRange.Rows.Count
printColumn = 9
.Columns(printColumn).EntireColumn.Delete
For i = 2 To rowCount
Set NSNrange = .Cells(i, 5)
Set PNrange = .Cells(i, 7)
Set KitIDrange = .Cells(i, 2)
NSN = NSNrange.Text
PN = PNrange.Text
KitID = KitIDrange.Text
For j = 2 To rowCount
If .Cells(j, printColumn).Value = vbNullString Then
Set NSNrange = .Cells(j, 5)
Set PNrange = .Cells(j, 7)
Set KitIDrange = .Cells(j, 2)
NSNCheck = NSNrange.Text
PNCheck = PNrange.Text
KitIDCheck = KitIDrange.Text
If NSN = NSNCheck And PN = PNCheck And KitID = KitIDCheck Then
.Cells(j, printColumn).Value = "Duplicated on row " & i
End If
End If
Next j
Next i
End With
MsgBox "Search Complete"
End Sub
So it's correct that you assign objects with set (not just range). A cell is an object and can be assigned to a range variable. But when you use methods and properties of objects, in this case .Value, it does not mean that the return value is a range object.
So if you need to know what all propertys and methods to, i highly recommend the microsoft documentation.
So when you use .Value, you get back a variant (depending on the type of the value). In your use-case you can just assign it to a string, i.e Dim str as string: str = Cells(1,1).Value. If you just want the cellas an object that you can reference: Dim cell as Range: Set cell = Cells(1,1). Now can can adress all propertys and methods for example: cell.Value instead of Cells(1,1).Value.
Just a few other things that are useful to know. In VBA not like in VB.Net, that you better not mix up, if you Dim var1, var2 as String only var2 is a string, var1 is a variant. So its required to specify the type for each variable, Dim var1 as String, var2 as String.
Another thing that you might want to change is assigning Cells, Range to a specific Worksheet. Depending on which module your code is in, it can happen that you code runs on the wrong worksheet. (Also it minimizes errors when other people adjust/run the code), but mainly you just have to change one variable, if you want to refer to another Worksheet. It can be done with using Worksheet-Object.
Dim ws as Worksheet
Dim str as String
Set ws = Worksheets(1)
'Now adress methods and properties with ws
str = ws.Cells(1,1).Value
Also note here the object is Worksheet without an s. Worksheets is the collection of the Worksheet of the current Workbook.
You can also use the RemoveDuplicates method.
'Remove duplicates based on the data in columns; 2 "Kit", 5 "NSN", and 7 "PN".
ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(2, 5, 7), Header:=xlYes

Replace cell values in specific sheets with defined name

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

Type Mismatch 13 error when trying to activate a sheet

Everything I've read shows that I'm correctly denoting my variable and calling the sheet I want to activate. The last line is where I am getting the type mismatch. At that point CPIDws = CERN000006. I read somewhere that it might be problematic that the name is letters and numbers, but haven't found a way around it.
Sub Create_tab()
Dim newWS As Worksheet, CernWS As Worksheet, CPID As Variant
Dim Template As Worksheet, CPIDclm As Long, CERNdata As Range, CPIDcheck As Variant
Dim lngRow As Long, lngCol As Long, i As Integer, CPIDws As Worksheet
Set Template = Sheets("Template")
Set CernWS = Sheets("CERN ID's")
'Set lngRow = 1
'Set lngCol = 1
CernWS.Activate
Cells(1, 1).Select
Do
ActiveCell.Offset(1, 0).Select
Set CPID = ActiveCell
'create a new sheet as a copy of the template
Sheets("Template").Copy _
after:=ActiveWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'Name the new sheet as the current CPID value from CERN ID's worksheet
ActiveSheet.Name = CPID
Set CPIDws = ActiveSheet
'interigate AAA Data and update the new sheet with the data specific to the current cpid
Sheets("AAA Data").Activate
Cells(2, 3).Activate
Set CPIDcheck = ActiveCell
Do
If CPID = CPIDcheck Then
ActiveCell.Offset(0, -2).Select
Set CERNdata = Range(Selection, Selection.End(xlToRight))
End If
Sheets(CPIDws).Activate
At that point CPIDws = CERN000006.
No it doesn't. :)
You've declared CPIDws As Worksheet but you're using it as an argument to the Sheets method, which takes either an index (integer) or name (string) value.
Thus, type mismatch.
Try simply CPIDws.Activate
or, arguably you could do the redundant: Sheets(CPIDws.Name).Activate
THIS may also come in helpful, as it's generally recommended not to rely on Active (cell, sheet, etc.) or Selection when it can be avoided (which is almost always the case, except for some instance when you use the Selection as a method of input. But generally, your macro should probably never need to Select or Activate any cell other than that which the user had selected for input. In your case, since you're beginning at Cells(1,1) and controlling the iteration entirely through code, it's not at all necessary to Select or Activate anything.

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