This question already has an answer here:
Application.Match gives type mismatch
(1 answer)
Closed 4 years ago.
I want to check for two conditions:
If Tabelle3.Cells(7 + i, 1) <> ""
If the Tabelle3.Cells(7 + i, 1) can be found in Tabelle8.Range("A:A")
In case one of them is not fulfilled I want it to jump to the next i.
Therefore, I'm using Application.Match for the second condition and the code is the following:
If Tabelle3.Cells(7 + i, 1) <> "" And Application.Match(Tabelle3.Cells(7 + i, 1), Tabelle8.Range("A:A"), False) Then
But the Run-Time Error '13' "Types Incompatible" occurs. Does someone know why and how I can make this one work? :)
Below the whole code:
Sub Test()
Dim lastrow2 As Long
lastrow2 = Tabelle3.Range("A" & Rows.Count).End(xlUp).Row
Set myrange2 = Tabelle8.UsedRange
For i = 2 To lastrow2
If Tabelle3.Cells(7 + i, 1) <> "" And Application.Match(Tabelle3.Cells(7 + i, 1), Tabelle8.Range("A:A"), False) Then
Tabelle3.Cells(7 + i, 19) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange2, 3, False)
Tabelle3.Cells(7 + i, 20) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange2, 4, False)
End If
Next i
End Sub
Run this code:
Sub TestMe()
Debug.Print CBool(Application.Match("Something", Range("A:A"), False))
End Sub
It prints True on the immediate window, although there is no string "Something" on the first column of your worksheet. Thus in your case, Application.Match(Tabelle3.Cells(7 + i, 1), Tabelle8.Range("A:A"), False) will always be evaluated to True and this is not how it should be.
Consider some check for errors like IsError(Application.Match(Tabelle3.Cells(7 + i, 1), Tabelle8.Range("A:A"), False)), which would be True, in case that the value cannot be found.
Related
I am working on a workbook that has three tabs. My Customer list Addresses, Outsource customer listing addresses: and Output No Match:. I am looking to run my list agents an outsource list and if my address list does not match any addresses on the out source list. It outputs on the No match tab.
I have built a working document but it is so slow and feel someone here could really help point me in the right direction.
All three sheets column headers ("Customer Name","Address 1","Address 2","City","State","Zip Code")
I am using a code similar to the one below to find none matches on all the columns. It only looks at the first few characters in hope to speed things up but i am getting no where fast.
I am running it on a loop somewhat like this which seems to be very incessant and slow when comparing addresses agent 200,000 records.
For I = 2 To LastRow
If Left(UCase(Trim(wsAddressS_1.Cells(1 + I, 6).Value)), 5) =
Left(UCase(VLookLike(wsAddressS_1.Cells(1 + I, 6).Value, wsAddressS_2.Range("F1:F" & LastRow2 + 10))), 5) Then
Match_Zip = "Match"
Else
Match_Zip = "No Match"
End If
If strMatchZip <> "Match" Then
LastRow1 = wsAddressS_4.Range("F" & Rows.Count).End(xlUp).Row
wsAddressS_4.Cells(LastRow4 + 1, 1).Value = wsAddressS_1.Cells(1 + I, 1).Value
wsAddressS_4.Cells(LastRow4 + 1, 2).Value = wsAddressS_1.Cells(1 + I, 2).Value
wsAddressS_4.Cells(LastRow4 + 1, 3).Value = wsAddressS_1.Cells(1 + I, 3).Value
wsAddressS_4.Cells(LastRow4 + 1, 4).Value = wsAddressS_1.Cells(1 + I, 4).Value
wsAddressS_4.Cells(LastRow4 + 1, 5).Value = wsAddressS_1.Cells(1 + I, 5).Value
wsAddressS_4.Cells(LastRow4 + 1, 6).Value = wsAddressS_1.Cells(1 + I, 6).Value
End If
Sleep 10
DoEvents
Next I
e.g VLookLike
Private Function VLookLike(txt As String, rng As Range) As String
Dim temp As String, e, n As Long, a()
Static RegX As Object
If RegX Is Nothing Then
Set RegX = CreateObject("VBScript.RegExp")
With RegX
.Global = True
.IgnoreCase = True
.Pattern = "(\S+).*" & Chr(2) & ".*\1"
End With
End If
With RegX
For Each e In rng.Value
If UCase$(e) = UCase(txt) Then
VLookLike = e
Exit For
End If
temp = Join$(Array(e, txt), Chr(2))
If .test(temp) Then
n = n + 1
ReDim Preserve a(1 To 2, 1 To n)
a(2, n) = e
Do While .test(temp)
a(1, n) = a(1, n) + Len(.Execute(temp)(0).submatches(0))
temp = Replace(temp, .Execute(temp)(0).submatches(0), "")
Loop
End If
Next
End With
If (VLookLike = "") * (n > 0) Then
With Application
VLookLike = .HLookup(.Max(.Index(a, 1, 0)), a, 2, False)
End With
End If
End Function
Any help or suggestions would be much appreciated!
I haven't read all the code, sorry, but I have had problems on comparing strings. Perhaps it would work if you tell vba that you are gonna compare 2 strings. You could use the function Cstr() for example
CStr(Left(UCase(StrAddress), 3)) = CStr(Left(UCase(VLookLike(StrAddress, rng2)), 3))
I am using the following code to consolidate two Worksheets (Sheet 5 and Sheet 3). More precisely, I am adding the data from Sheet 5 to Sheet 3 what is working smooth as long as have opened Sheet 3 when processing the code. However, when I switch to another sheet and run the code, the code doesn't work properly anymore.
When I run the code for the first time it works smooth
When I run the code repeatedly nothing should happen, because my macro just inserts data from Sheet 5 in Sheet 3that isn't already in Sheet 3 and since this data has already been inserted in the first run nothing should happen. This is the case, when I stay on Sheet 3. However, if I switch to another sheet and run the code a second, third, fourth time, then the macro is partly executed everytime.
Let me explain this a lil bit further:
For my tests I am using three rows with data. When I execute the button a first time, all three rows in Sheet 5 are added to Sheet 3. When I press the button a second, third, fourth time three rows are added to Sheet 3
First added row: Is empty
Second & Third added row: contain the data of the second and third row in Sheet 3
Does anyone have an idea what is going wrong here?
Sub Consolidation()
Dim lastrow As Long
Dim NFR As Long
lastrow = Tabelle5.Range("A" & Rows.Count).End(xlUp).Row
NFR = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(-3).Row
Set myrange = Tabelle5.UsedRange
For i = 4 To lastrow
On Error Resume Next
If Tabelle3.Cells(5 + i, 1) <> "" And Not IsError(Application.Match(Tabelle3.Cells(5 + i, 1), Tabelle5.Range("A:A"), False)) Then
Tabelle3.Cells(5 + i, 2) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(5 + i, 1), myrange, 2, False)
End If
If IsError(Application.Match(Tabelle5.Cells(i, 1), Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row), False)) Then
Tabelle3.Cells(NFR + i, 1) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 1, False)
Tabelle3.Cells(NFR + i, 2) = Application.WorksheetFunction.VLookup(Tabelle5.Cells(i, 1), myrange, 2, False)
End If
Next i
Set Rng = Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row)
On Error Resume Next
Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Something like this (untested):
Sub Consolidation()
Dim lastrow As Long
Dim NFR As Long, r, v
lastrow = Tabelle5.Range("A" & Rows.Count).End(xlUp).Row
NFR = Tabelle3.Range("A" & Rows.Count).End(xlUp).Offset(-3).Row
Set myrange = Tabelle5.UsedRange
For i = 4 To lastrow
v = Tabelle3.Cells(5 + i, 1)
If v <> "" And Not IsError(Application.Match(v, Tabelle5.Range("A:A"), False)) Then
r = Application.VLookup(v, myrange, 2, False)
Tabelle3.Cells(5 + i, 2) = IIf(IsError(r), "No match", r)
End If
v = Tabelle5.Cells(i, 1)
If IsError(Application.Match(v, Tabelle3.Range("A9:A" & _
Tabelle3.Range("A1048576").End(xlUp).Offset(8).Row), False)) Then
r = Application.VLookup(v, myrange, 1, False)
Tabelle3.Cells(NFR + i, 1) = IIf(IsError(r), "No match", r)
r = Application.VLookup(v, myrange, 2, False)
Tabelle3.Cells(NFR + i, 2) = IIf(IsError(r), "No match", r)
End If
Next i
Set Rng = Tabelle3.Range("A9:A" & Range("A1048576").End(xlUp).Offset(8).Row)
On Error Resume Next
Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
I want to use a if-function to distingiush between two sceneraios.
For Each Cell In Tabelle3.Range("A" & lastrow2)
Option A: If Cell <> "" Then run code
Option B: If Cell = "" Then skip this empty cell and go on with the next one
Here the whole code:
Sub IfFunction()
Dim lastrow2 As Long
lastrow2 = Tabelle3.Range("A" & Rows.Count).End(xlUp).Row
Set myrange2 = Tabelle8.UsedRange
For i = 2 To lastrow2
For Each Cell In Tabelle3.Range("A" & lastrow2)
If Cell = "" Then i = i + 1
Else: i = i
Tabelle3.Cells(7 + i, 19) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange2, 3, False)
Tabelle3.Cells(7 + i, 20) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange2, 4, False)
Tabelle3.Cells(7 + i, 21) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange2, 5, False)
Next i
End If
End Sub
When I try to run this code, it does not execute because an error occurs that there is a 'ELSE without IF'-Function.
Does anyone know how I can use an IF-function here or what to use instead? Thanks. :)
if you continue writing after Then this means the If statement consists of one line only:
If Cell = "" Then i = i + 1 'End If automatically here
Then the Else has to be in that line too:
If Cell = "" Then i = i + 1 Else i = i 'End If automatically here
If you want to use a multi line If statement
If Cell = "" Then
i = i + 1
Else
i = i
End If
But …
because i = i doesn't do anything you can just write
If Cell = "" Then i = i + 1
and omit the Else part completely because it does nothing at all.
And anther but …
because you are using a For i the Next i increments i automatically and you don't need to increment it yourself. There is no i = i + 1 needed
your code has to For but one Next only, which would result in a syntax error
furthermore the Next i is intertwined with a If-Then-Else block code which would also result in a syntax error
finally I guess you're iterating twice along Tabelle3 column A cells from row 2 to last not empty one, while you only need it once
Summing all that up, I'd say you can use this code:
Option Explicit
Sub IfFunction()
Dim myrange2 As Range, cell As Range
Set myrange2 = Tabelle8.UsedRange
With Tabelle3
For Each cell In .Range("A2:A" & .Cells(.Rows.count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants)
cell.Offset(7, 18) = Application.WorksheetFunction.VLookup(cell.Offset(7), myrange2, 3, False)
cell.Offset(7, 19) = Application.WorksheetFunction.VLookup(cell.Offset(7), myrange2, 4, False)
cell.Offset(7, 20) = Application.WorksheetFunction.VLookup(cell.Offset(7), myrange2, 5, False)
Next
End With
End Sub
Okay that was actually way to simple :D I was running through the same column twice by
For Each Cell In Tabelle3.Range("A" & lastrow2)
If Cell = "" Then i = i + 1
Else: i = i
and
For i = 2 To lastrow2
Instead I can simply use:
For i = 2 To lastrow2
If Tabelle3.Cells(7 + i, 1) <> "" Then
Tabelle3.Cells(7 + i, 19) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange2, 3, False)
Tabelle3.Cells(7 + i, 20) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange2, 4, False)
Tabelle3.Cells(7 + i, 21) = Application.WorksheetFunction.VLookup(Tabelle3.Cells(7 + i, 1), myrange2, 5, False)
End if
Next i
Thanks alot for your help & contribution!
I'm trying to run a For Next Loop until the last row of a specific column (but not the last row of the sheet). So the first part of my list has data in column F and the second part doesn't. I only want the macro to apply to that first part. For some reason the loop only runs through the first part with certain commands but doesn't with the ones I am trying to do now. (I know it would be easy just to seperate the two parts manually and then run it but it drives me nuts not knowing what it is I did wrong :)).
This is the code:
Dim i As Integer
Dim g As Double
g = 0.083333333
Dim lastrow As Long
lastrow = Sheets("zm").Range("f" & Rows.Count).End(xlUp).Row
Sheets("zm").Activate
For i = 2 To lastrow
If Sheets("zm").Cells(i, 1) = Sheets("zm").Cells(i + 1, 1) And Sheets("zm").Cells(i, 5) = Sheets("zm").Cells(i + 1, 5) And Sheets("zm").Cells(i + 1, 6) - Sheets("zm").Cells(i, 7) < g Then
Sheets("zm").Cells(i + 1, 7).Copy
Sheets("zm").Cells(i, 7).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("zm").Rows(i + 1).Delete
End If
Next i
Thanks for your help!
avoid Select/Selection and/or Activate/ActiveXXX
try this:
Option Explicit
Sub main()
Dim i As Long, lastrow As Long
Dim g As Double
g = 0.083333333
With Worksheets("zm")
lastrow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = lastrow To 2 Step -1
If .Cells(i, 1) = .Cells(i + 1, 1) And .Cells(i, 5) = .Cells(i + 1, 5) And .Cells(i + 1, 6) - .Cells(i, 7) < g Then
.Cells(i + 1, 7).Copy Destination:=.Cells(i, 7)
.Rows(i + 1).Delete
End If
Next i
End With
End Sub
Someone helped me out with code for VBA in Excel. My code is as follows:
Sub VidyaGames()
Dim LastRow As Variant, j As Integer
LastRow = Range("A65536").End(xlUp).Address
j = 2
For i = 1 To Range("A1", LastRow).Rows.Count + 1 Step 10
Worksheets("Sheet1").Cells(j, 1) = Worksheets("PlayerInfoAll").Cells(i, 2)
Worksheets("Sheet1").Cells(j, 2) = Worksheets("PlayerInfoAll").Cells(i + 1, 2)
Worksheets("Sheet1").Cells(j, 3) = Application.WorksheetFunction.Sum(Worksheets("PlayerInfoAll").Range(Cells(i + 3, 1), Cells(i + 3, 1).End(xlToRight)))
Worksheets("Sheet1").Cells(j, 4) = Application.WorksheetFunction.Sum(Worksheets("PlayerInfoAll").Range(Cells(i + 4, 1), Cells(i + 4, 1).End(xlToRight)))
Worksheets("Sheet1").Cells(j, 5) = Worksheets("PlayerInfoAll").Cells(i + 5, 2)
Worksheets("Sheet1").Cells(j, 6) = Worksheets("PlayerInfoAll").Cells(i + 6, 2)
Worksheets("Sheet1").Cells(j, 7) = Worksheets("PlayerInfoAll").Cells(i + 7, 2)
Worksheets("Sheet1").Cells(j, 8) = Worksheets("PlayerInfoAll").Cells(i + 8, 2)
Try
Worksheets("Sheet1").Cells(j, 9) = Application.WorksheetFunction.IsNA ((Application.WorksheetFunction.Match(730, Worksheets("PlayerInfoAll").Range(Cells(i + 2, 1), Cells(i + 2, 1).End(xlToRight)), 0)))
Catch
Worksheets("Sheet1").Cells(j, 9) = 0
j = j + 1
Next i
End Sub
The code takes data from "Blocks" in one sheet and puts them into a readable/SPSS-like format in another sheet. I added the Try and Catch code at the bottom, but it doesn't seem to be working. If i run the line without the Try and Catch line, the code will terminate when it finds a row that does NOT contain the identifier ("730"). I looked up try and catch, thinking it was like Python's try and except but when I try to run it i get the message "Compile error: Sub or function not defined" and Try is highlighted.
Does Try/Catch work like Python's Try/Except? If so, how do I get it to work here?
While VBA has no such thing as a Try/Catch block you could use standard Error Handling for this such as
Sub VidyaGames()
For i = 1 To Range("A1", LastRow).Rows.Count + 1 Step 10
....
Worksheets("Sheet1").Cells(j, 9) = TryCatchWorkAround(i)
j = j + 1
Next i
End Sub
Private Function TryCatchWorkAround(i AS Integer) AS Integer
On Error GoTo Handler
TryCatchWorkAround = Application.WorksheetFunction.IsNA ((Application.WorksheetFunction.Match(730, Worksheets("PlayerInfoAll").Range(Cells(i + 2, 1), Cells(i + 2, 1).End(xlToRight)), 0)))
Exit_TryCatchWorkAround:
Exit Function
Handler:
TryCatchWorkAround = 0
Resume Exit_TryCatchWorkAround
End Function
This will perform the same function just using VBA Standard Error Handling.
VBA does not offer try/catch blocks. You could try modifying error handling by using On Error Goto xxx where xxx is a label where your error handling code resides. Look up On Error Goto ... on the internet for more information.