Can anyone help me? (I am new in VBA and i also got help to create this macro)
I created a macro for a file and first it was working fine, but today I've been opening and restarting the file and macro hundreds of times and I'm always getting the following error: Excel VBA Run-time error '13' Type mismatch
I didn't change anything in the macro and don't know why am I getting the error. Furthermore it takes ages to update the macro every time I put it running (the macro has to run about 700 rows).
The error is in the between ** **.
VBA:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim j As Integer
Dim z(8) As Integer
Set ws = ThisWorkbook.ActiveSheet
For i = 6 To ws.Cells.SpecialCells(xlCellTypeLastCell).Row - 3
If Not ws.Rows(i).Hidden = True Then
For j = 0 To 8
If Not ws.Cells(i, j + 5) = "" Then
** z(j) = z(j) + ws.Cells(i, j + 5) **
End If
Next j
End If
Next i
Application.EnableEvents = False
For j = 0 To 8
ws.Cells(ws.Cells.SpecialCells(xlCellTypeLastCell).Row - 2, j + 5) = z(j)
Next j
Application.EnableEvents = True
End Sub
ws.Cells(i, j + 5) at a particular point does not contain a value that can be added to z(j). It's probably blank or doesn't contain a number.
One fix would be to write
On Error Resume Next 'switch off error handling
z(j) = z(j) + ws.Cells(i, j + 5)
On Error Goto 0 'the idiomatic way of switching the default error handling back on
Effectively then, your macro will not attempt to add a non-numeric value to z(j).
But solving the problem this way is a bit like using a sledgehammer to crack a nut: perhaps it's worth investigating the contents of the cell that's causing the error, and programming around that more elegantly.
Also, I question why this needs to be in VBA in the first place. Really you're doing something that excel can do in normal calculation. (Consider SUMIF and SUMIFS) Failing that, it would be quicker if you used a VBA Function rather than responding to change events.
In addition to what #Bathsheba mentioned, you might also want to consider declaring variables before using them to avoid problems. I wasn't able to run your code because Excel wouldn't know how to handle Z() and thought of it as a UDF. Try the following and let me know if this solves the problem:
Option Base 0
Option Explicit
Sub tmpTest()
Dim ws As Worksheet
Dim i As Long, j As Integer
Dim z(0 To 8) As Double
Set ws = ThisWorkbook.ActiveSheet
For i = 6 To ws.Cells.SpecialCells(xlCellTypeLastCell).Row - 3
If Not ws.Rows(i).Hidden = True Then
For j = 0 To 8
If Not ws.Cells(i, j + 5) = "" Then
z(j) = z(j) + IIf(VarType(ws.Cells(i, j + 5).Value) = vbError, 0, ws.Cells(i, j + 5).Value)
End If
Next j
End If
Next i
Application.EnableEvents = False
For j = 0 To 8
ws.Cells(ws.Cells.SpecialCells(xlCellTypeLastCell).Row - 2, j + 5) = z(j)
Next j
Application.EnableEvents = True
End Sub
Related
I want to start second for from next current first for counter I run this code and this error prevent to run code.
ERROR : type mismatch
This code should show shortest distance cells as when find next cell(short distance) this cell should remove from search
also I want to return the address(ROW NUMBER) of next cell(shortest distance)
`Sub distance()
Dim j, i As Integer, ws As Worksheet
Set ws = Worksheets("activesheet")
For i = 2 To 87
For j = i+1 To 87
If j <> i Then
Worksheets("activesheet").Cells(j, 11).Value = Sqr(((Worksheets("activesheet").Cells(i,
8).Value) - (Worksheets("activesheet").Cells(j, 8).Value)) ^ 2 +
((Worksheets("activesheet").Cells(i, 9).Value) - (Worksheets("activesheet").Cells(j,
9).Value)) ^ 2)
Next j
ws.Range("l" & i) = Application.WorksheetFunction.Small(ws.Range("k2:k87"), 1)
Next i
End Sub`
I have reformatted your code so I could read it, it would not compile because you were missing an End If (as indicated by a comment in the formatted code below). The code runs fine on a test workbook I have just created. However of course I don't know what source data you have.
Sub distance()
Dim j, i As Integer, ws As Worksheet
Set ws = Worksheets("activesheet")
For i = 2 To 87
For j = i + 1 To 87
If j <> i Then
Worksheets("activesheet").Cells(j, 11).Value = Sqr(((Worksheets("activesheet").Cells(i, 8).Value) - (Worksheets("activesheet").Cells(j, 8).Value)) ^ 2 + ((Worksheets("activesheet").Cells(i, 9).Value) - (Worksheets("activesheet").Cells(j, 9).Value)) ^ 2)
End If 'this was missing
Next j
ws.Range("l" & i) = Application.WorksheetFunction.Small(ws.Range("k2:k87"), 1)
Next i
End Sub
Given that this runs okay, I recommend checking the data being used from the worksheet on this line
Worksheets("activesheet").Cells(j, 11).Value = Sqr(((Worksheets("activesheet").Cells(i, 8).Value) - (Worksheets("activesheet").Cells(j, 8).Value)) ^ 2 + ((Worksheets("activesheet").Cells(i, 9).Value) - (Worksheets("activesheet").Cells(j, 9).Value)) ^ 2)
and this line
ws.Range("l" & i) = Application.WorksheetFunction.Small(ws.Range("k2:k87"), 1)
and make sure you are getting data of the correct type. Do you have any words or letters or non numeric data of any kind being used?
To demonstrate the problem, below I am trying to divide the variable A (a string) by the variable B (an integer) and get a type mismatch error as a result.
Sub test()
Dim a As String
a = "test"
Dim b As Integer
b = 1
Debug.Print a / b
End Sub
I got an initial code but it's not working correctly, if you guys have any suggestions on how to achieve it and make the code better (cleaner/faster) I would really appreciate it.
Sub CountByError()
Dim rangeArr() As Variant
Dim xcharFlag As Boolean
Dim tester2 As Worksheet
Set tester2 = Worksheets("tester2")
rangeArr = Worksheets("tester").Range("a2").Resize(3169, 30).Value2
Dim i As Long, j As Long
For i = 1 To 29
Select Case i
Case 1
For j = 1 To 3168
xcharFlag = False
For k = 1 To Len(rangeArr(j, i))
If Not Mid(Len(rangeArr(j, i)), k, 1) Like "[a-zA-Z0-9-]" Then
xcharFlag = True
If xcharFlag = True Then Exit For
End If
Next k
If xcharFlag = True Then
tester2.Range("d4") = tester2.Range("d4") + 1
End If
Next j
End Select
Next i
Worksheets("tester").Range("a2").Resize(3169, 30).Value2 = rangeArr
End Sub
It's always good to split the code into smaller pieces. In your case, I would suggest you move the check if a string contains invalid characters into a boolean function. That makes it much easier to test and debug.
Function containsInvalidChar(ByVal s As String) As Boolean
Dim k As Long
For k = 1 To Len(s)
If Not Mid(s, k, 1) Like "[a-zA-Z0-9-]" Then
containsInvalidChar = True
Exit Function
End If
Next k
containsInvalidChar = False
End Function
Now open the immediate window and enter something like (the TRUE and FALSE is the response).
? containsInvalidChar("ABC")
FALSE
? containsInvalidChar("12-34 56")
TRUE
? containsInvalidChar(ActiveCell)
FALSE
Once you are rather sure that the function works as expected, remove the code from your nested loops and replace it with a simple call to the function:
(...)
For j = 1 To 3168
If containsInvalidChar(rangeArr(j, i)) then
tester2.Range("d4") = tester2.Range("d4") + 1
End If
Next j
By this, you separate the logic how to identify an invalid string from the logic of how to deal with that situation. You could easily change the function to use regular expressions instead of the like (which probably would increase execution speed) without touching the rest of the code, or you could reuse the function to mark invalid words with a different color (could even be used as function in conditional formatting).
Your current check, by the way, has a superfluent Len( in the check.
This is how it should work
Sub CountByError()
Dim rangeArr() As Variant
Dim tester2 As Worksheet
Dim i As Long, j As Long, k As Long
Set tester2 = Worksheets("tester2")
rangeArr = Worksheets("tester").Range("a2").Resize(3169, 30).Value2
tester2.Range("d4") = 0
For i = LBound(rangeArr, 1) To UBound(rangeArr, 1)
For j = LBound(rangeArr, 2) To UBound(rangeArr, 2)
For k = 1 To Len(rangeArr(i, j))
If Mid(rangeArr(i, j), k, 1) Like "[!a-zA-Z0-9-]" Then
tester2.Range("d4") = tester2.Range("d4") + 1
Exit For
End If
Next k
Next j
Next i
End Sub
The macro may be slow and some changes to optimize the code may be useful.
I have a workbook where I want to find the differences of two sheets by looking at the company name and their corporate registration number and then type the differences on the third sheet.
I have tried the code in another workbook with only 143 rows, which works perfectly, but when I try it on the real workbook with 10,000 rows I get a "type mismatch error". Also if I use other columns than the CVR and Firm columns the code also works.
The CVR is numbers and Firms are strings (firm names). I get the
type mismatch error
on the line I marked **. Does somebody know why I get this error?
Sub ComCVR()
Dim CVR1()
Dim CVR2()
Dim Firm1()
Dim Firm2()
Dim n As Long, m As Long
Dim i As Double, j As Double
Dim intCurRow1 As Integer, intCurRow2 As Integer
Dim rng As Range, rng1 As Range
Set rng = ThisWorkbook.Sheets("Last month").Range("A11")
Set rng1 = ThisWorkbook.Sheets("Current month").Range("A11")
n = rng.CurrentRegion.Rows.Count
m = rng1.CurrentRegion.Rows.Count
ReDim CVR1(n)
ReDim Firm1(n)
ReDim CVR2(m)
ReDim Firm2(m)
ThisWorkbook.Sheets("CVR").Range("A1") = "Flyttet CVR"
ThisWorkbook.Sheets("CVR").Range("B1") = "Flyttet Firmanavn"
ThisWorkbook.Sheets("CVR").Range("A1:B1").Interior.ColorIndex = 3
ThisWorkbook.Sheets("CVR").Range("C1") = "Nye CVR"
ThisWorkbook.Sheets("CVR").Range("D1") = "Nye Firmanavn"
ThisWorkbook.Sheets("CVR").Range("C1:D1").Interior.ColorIndex = 4
ThisWorkbook.Sheets("CVR").Range("A1:D1").Font.Bold = True
' Inset data to arrays
For i = 0 To n
CVR1(i) = ThisWorkbook.Sheets("Last month").Cells(12 + i, 5)
Firm1(i) = ThisWorkbook.Sheets("Last month").Cells(12 + i, 4)
Next
For i = 0 To m
CVR2(i) = ThisWorkbook.Sheets("Current month").Cells(12 + i, 5)
Firm2(i) = ThisWorkbook.Sheets("Current month").Cells(12 + i, 4)
Next
intCurRow1 = 2
intCurRow2 = 2
'Old
For i = 0 To n
For j = 0 To m
If Firm1(i) = ThisWorkbook.Sheets("Current month").Cells(12 + j, 4) Then '** Error raised here
Exit For
End If
If j = m Then
ThisWorkbook.Sheets("CVR").Cells(intCurRow1, 1) = CVR1(i)
ThisWorkbook.Sheets("CVR").Cells(intCurRow1, 2) = Firm1(i)
intCurRow1 = intCurRow1 + 1
End If
Next j
Next i
'new
For i = 0 To m
For j = 0 To n
If Firm2(i) = ThisWorkbook.Sheets("Last month").Cells(12 + j, 4) Then
Exit For
End If
If j = n Then
ThisWorkbook.Sheets("CVR").Cells(intCurRow2, 3) = CVR2(i)
ThisWorkbook.Sheets("CVR").Cells(intCurRow2, 4) = Firm2(i)
intCurRow2 = intCurRow2 + 1
End If
Next j
Next i
Columns("A:B").Select
ActiveSheet.Range("$A:$B").RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = False
Columns("C:D").Select
ActiveSheet.Range("$C:$D").RemoveDuplicates Columns:=1, Header:=xlNo
Application.DisplayAlerts = False
End Sub
Whenever an error happens, the best way is to google it. This is what it says in the documentation of VBA for Type mismatch:
Cause: The variable or property isn't of the correct type. For example, a variable that requires an integer value can't accept a string value unless the whole string can be recognized as an integer.
In the case of the code, it happens, when an array is compared with excel cell. Now the trick - in order to see why it happens, see what is in these:
Debug.Print ThisWorkbook.Sheets("Last month").Cells(12 + i, 4)
Debug.Print Firm1(i)
and the after the error runs, take a look at the immediate window (Ctrl+G). It it quite possible, that there is an error in the excel cell, thus it cannot be compared. This is some easy way to avoid it, if this is the case:
Sub TestMe()
Dim myRange As Range
Set myRange = Worksheets(1).Cells(1, 1)
myRange.Formula = "=0/0"
If Not IsError(myRange) Then
Debug.Print CBool(myRange = 2)
Else
Debug.Print myRange.Address; " is error!"
End If
End Sub
My code loops through rows with data on one master-sheet and updates different sheets based on the category of the data on each row. When I run the macro, I can see the information temporarily flash where it should be pasted on the worksheet before disappearing. This does not happen where I have used the same copy/paste command before.
The beggining two loops with WOB and ROP will paste correctly while the custom loop does not. I have also tried making the Select Case into several elseif statements which has the same non-working result.
Sub SortData()
Dim Datasheet As Worksheet
Dim ROPsheet As Worksheet 'Rate of Penetration
Dim Customsheet As Worksheet
Dim WOBsheet As Worksheet 'Weight on Bit
Dim i As Long 'Used as counter to loop through compiled data sheet
Dim j As Long 'Used as counter for each Limiter tested
Dim LastRowCount As Long 'Finds number of rows for ending loop
Dim Limiter As String 'These are WOB, ROP, Custom ect.
Dim DepthCheck As Double 'Checks depth on individual limiter sheet with depth on data sheet
Dim DatetCheck As String 'Checks date on individual limiter sheet with depth on data sheet
Dim Depth As Double 'depth from data sheet
Dim Datet As String 'date from limiter sheet
Dim y As Double 'Used to progress through rows
Set Datasheet = Worksheets("Data")
Set ROPsheet = Worksheets("ROP")
Set Customsheet = Worksheets("Custom")
Set WOBsheet = Worksheets("WOB")
y = 1
i = 1
'_____________________________________Working_Code_Below__________________________________________________________
'Arbitrary Count for testing
For i = 1 To 100
y = y + 1
Limiter = Worksheets("Data").Cells(y, 2).Value
Depth = Worksheets("Data").Cells(y, 5).Value
Datet = Worksheets("Data").Cells(y, 6).Value
'WOB
If Limiter = "WOB" Then
j = 1
LastRowCount = WOBsheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Count
For j = 1 To LastRowCount
DepthCheck = Worksheets("WOB").Cells(j + 1, 5).Value
DatetCheck = Worksheets("WOB").Cells(j + 1, 6).Value
If DepthCheck <> Depth Or DatetCheck <> Datet Then
If j = LastRowCount Then
Datasheet.Range(Datasheet.Cells(y, 2), Datasheet.Cells(y, 13)).Copy Sheets("WOB").Cells(j + 1, 2)
GoTo EndLast
End If
Else
GoTo EndLast
End If
Next j
Else
GoTo ROPStart
End If
ROPStart:
If Limiter = "ROP" Then
j = 1
LastRowCount = ROPsheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Count
For j = 1 To LastRowCount
DepthCheck = Worksheets("ROP").Cells(j + 1, 5).Value
DatetCheck = Worksheets("ROP").Cells(j + 1, 6).Value
If DepthCheck <> Depth Or DatetCheck <> Datet Then
If j = LastRowCount Then
Datasheet.Range(Datasheet.Cells(y, 2), Datasheet.Cells(y, 13)).Copy Sheets("ROP").Cells(j + 1, 2)
GoTo EndLast
End If
Else
GoTo EndLast
End If
Next j
Else
GoTo CustomStart
End If
CustomStart:
j = 1
LastRowCount = Customsheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Count
Select Case Limiter
Case "WOB", "Balling", "RPM", "Vibrations", "Torque", "Buckling", "Differential Pressure", "Flow Rate", "Pump Pressure", "Well Control", "Directional", "Logging", "ROP"
GoTo EndLast
Case Else
For j = 1 To LastRowCount
DepthCheck = Worksheets("Custom").Cells(j + 1, D).Value
DatetCheck = Worksheets("Custom").Cells(j + 1, dt).Value
If DepthCheck <> Depth Or DatetCheck <> Datet Then
If j = LastRowCount Then
Datasheet.Range(Datasheet.Cells(y, 2), Datasheet.Cells(y, 13)).Copy Sheets("Custom").Cells(j + 1, 2)
GoTo EndLast
End If
Else
GoTo EndLast
End If
Next j
End Select
EndLast:
Next i
End Sub
No error messages appear.
PS. This is my first post so sorry if formatting is weird.
Welcome to SO and congratulations on your first post. One of these days I'll be there with you, I'm just looking for the perfect question that's all. Lack of courage has nothing to do with it, really, scout's honor. Pinky promise!
I've tried following your code and struggle quite a bit because of the nonlinear flow. The problem you describe sounds like the data is written and then overwritten. This would typically be caused by a superfluous loop, in your case it may be induced by GoTo.
Touching on the comments about finding the row count; this is a surprisingly nuanced subject with many different answers and the correct one dependent on your circumstances and needs. Most of the time I can use UsedRange, as in Sheet1.UsedRange.Rows.Count; but I predominately work on spreadsheets I maintain and keep things as tight as my knowledge allows at the time. I don't remember how long ago I bookmarked this website but I swear I used it daily for a couple months straight: OZGrid Excel Ranges And of course Chip Pearson is worth a call out CPearson Last Used Cell
Please take this last bit as constructive criticism and have a good laugh. When you try to follow this code and get lost, take a step back, look at your code, and find the same pattern - and stop doing it. Break the habit and break the habit hard. Some people, myself included have a near visceral reaction when trying to debug spaghetti code. Try to write linearly top down. You'll find that you understand your own code better, it's easier to keep track of your thoughts, and transfer those thoughts into code. It's a win, win, win situation. GoTo's are almost entirely unnecessary and really impede the progress of others trying to help; using one here or there can be a handy little shortcut in a 5 line function but are best avoided when your code requires scrolling.
Sub aProcedure()
GoTo T
V:
j = vbCancel
b = "point"
GoTo K
X2:
j = x
b = "before"
GoTo K
A1:
For i = VbMethod To vbCancel
b = DoThingWith(DoThingWith(b, 44), b)
Next
j = j * 3
a = DoThingWith(a, b)
GoTo Z
Z:
b = "times"
GoTo K
U2:
j = j + 1 - x
b = "has"
GoTo K
A2:
MsgBox DoThingWith(a)
Exit Sub
X1:
j = j + 1
b = "made"
GoTo K
T:
a = "this"
GoTo U1
K:
a = DoThingWith(a, b)
DoEvents
Select Case j
Case 0
GoTo A2
Case 1
GoTo U1
Case 2
GoTo U2
Case 3
GoTo W
Case 4
GoTo X1
Case 5
GoTo Y
Case Else
GoTo X2
End Select
W:
j = 2 * (j - 1)
b = "been"
GoTo K
Y:
b = "many"
GoTo A1
U1:
a = Replace(a, Left(a, 1), UCase(Left(a, 1)))
GoTo V
End Sub
Private Function DoThingWith(a, Optional b = 46, Optional c = 32)
If IsNumeric(b) Then
b = CInt(b)
c = CInt(c)
Select Case Asc(Right(a, 1))
Case b
DoThingWith = a & Chr(b - c - 1)
Case Else
DoThingWith = a & Chr(b)
End Select
ElseIf IsNumeric(c) Then
c = CInt(c)
DoThingWith = a & Chr(c) & b
Else
DoThingWith = a & b & c
End If
End Function
The output:
I am trying to locate the first cell (row) stating "#N/A" in specific columns. I cannot work around a type mismatch error I get. I have googled and read a lot of similar stackflow questions and answers but still could not solve it.
The main things I have tried so far (besides various little changes):
used the immediate window and debug print to check outputs (the GetDates sub is working correctly)
converting the collection to an array where I can define a data type
using a while function instead of for (in this case I get it to attempt the while function but on the last iteration I get a type mismatch again)
here is the full code:
Dim EndofWeekDates As New Collection
Dim EndofRange As New Collection
Dim lCol As Long
Dim lRow As Long
Dim i As Long
Dim j As Long
Dim v As Long
Dim x As Long
Sub GetDates()
Set EndofWeekDates = Nothing
i = 4
j = 1
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
While j < lCol + 1
If Not IsEmpty(Cells(i, j).Value) And Not Cells(i, j).Value = "End" Then
EndofWeekDates.Add j
End If
j = j + 1
Wend
Call GetRange
End Sub
Sub GetRange()
Set EndofRange = Nothing
For x = EndofWeekDates.Count To 1 Step -1
lRow = Cells(Rows.Count, EndofWeekDates(x)).End(xlUp).Row
For v = 15 To lRow
If Cells(v, EndofWeekDates(x)).Value = "#N/A" Then
EndofRange.Add v
Exit For
End If
Next v
Next x
End Sub
I get the error in the following section on the IF line
For v = 15 To lRow
If Cells(v, EndofWeekDates(x)).Value = "#N/A" Then
EndofRange.Add v
Exit For
End If
Next v
The EndofWeekDates(x) should be constant during each 15 - lRow run while v changes. I have tried putting in the variable i (used earlier) instead of v and it works but only if i remains constant and is not changed in the for loop. As far as I can see the issue is with the v and not with EndofWeekDates(x). Furthermore, it seems that the issue only occurs when I do not use a constant but a changing number per for iteration. I tried to use the same while function as in GetDates but that did not solve it either.
Since v is declared as Long and I have also tried integer, I am stuck. Especially since the earlier used Cells.Value works with a Long which is increased in each iteration.
Your line
If Cells(v, EndofWeekDates(x)).Value = "#N/A" Then
is crashing because the cell does not contain the string "#N/A" but instead contains an error code, which Excel displays as #N/A.
A comparison of the error code to a string cannot be performed as there is no type conversion that allows the two sides of the comparison to be cast to a common data type - therefore it generates a "type mismatch" error.
The correct way to test for an #N/A error condition would be
If Application.IsNA(Cells(v, EndofWeekDates(x))) Then
This is a very peculiar error. I am not sure what is causing it but using Cells().Text instead of Cells().Value will work properly.
Try below
For v = 15 To lRow
If Cells(v, EndofWeekDates(x)).Text = "#N/A" Then
EndofRange.Add v
Exit For
End If
Next v
Alternatively,
For v = 15 To lRow
If Application.WorksheetFunction.IsNA(Cells(v, EndofWeekDates(x))) Then
EndofRange.Add v
Exit For
End If
Next v