Macro to match colums is getting error - excel

I want to check if cells in a column on sheet1 are in a column in sheet2 if it is then do nothing if it is not then past its value in the last row + 1
I get type mismatch on this line
If Application.Match(FindValues(i, 1), wsTarget.Range("A2:A" & sLR), 0) = False Then
Edit: This works
Thanks
'\\ IF cell found in match range then do sothing if not dosomthing else
Sub FindReplace_Updated_Blanks()
Dim FindValues As Variant
Dim ReplaceValues As Variant
Dim wsSource As Excel.Worksheet
Dim wsTarget As Excel.Worksheet
Dim sLR As Long
Dim tLR As Long
Dim i As Long
Sheets("Updated_Blanks").Select
Set wsSource = ThisWorkbook.Worksheets("Blanks")
Set wsTarget = ThisWorkbook.Worksheets("Updated_Blanks")
sLR = wsSource.Range("B" & wsSource.Rows.Count).End(xlUp).Row
tLR = wsTarget.Range("A" & wsSource.Rows.Count).End(xlUp).Row
FindValues = wsSource.Range("B2:B" & sLR).Value
For i = LBound(FindValues) To UBound(FindValues)
If Not IsError(Application.Match(FindValues(i, 1), wsTarget.Range("A2:A" & tLR), 0)) Then
Else
wsTarget.Range("A" & (tLR + 1)) = FindValues(i, 1)
End If
Next i
End Sub

You'll see generic messages like this when you use Application.WorksheetFunctions, or in this case Application.Match(). Most likely your Application.Match is returning a #N/A error, which VBA says is a "Type Mismatch" which is pretty generic.
You can see this error (Error 2042) if you assign the result of your Application.MAtch() formula to a variable and then print that variable value out. No worries though since #N/A is an expected result of the Match() Excel formula.

Related

Find value based off multiple for loops

I'm trying to take a part number from one sheet, find it in another sheet, then for the cells that correspond to tomorrow's date copy the quantity of parts for that specific part number plus two weeks out which is the resize. The code is starting to get really messy and I'm getting confused as to why it's not working. Currently I'm getting an error on cilrow = cil.rows with a mismatch.
Dim cel As Range
Dim cul As Range
Dim cil As Range
Dim cilrow As Long
Dim culcol As Long
Dim wkbOrig As Workbook
Dim wkbShape As Workbook
Dim shtShape As Worksheet
Set wkbOrig = ThisWorkbook
Set wkbShape = Workbooks("SHAPE Detailed coverage tracking WK" & WorksheetFunction.IsoWeekNum(Date))
Set shtShape = wkbShape.Worksheets("Detail coverage tracking")
For Each cel In wkbOrig.Sheets(2).Range("C3:C4,C9:C14")
For Each cil In shtShape.Range("H6:H11")
If Left(cel, 10) = cil.Value Then
cilrow = cil.Rows
For Each cul In shtShape.Range("5:5")
If cul.Value = Date + 1 Then
culcol = cul.Column
Range(Cells(cilrow, culcol)).Resize(, 14).Copy
End If
Next
End If
Next
Next
You can do less looping if you use Match().
Untested:
Sub Tester()
Dim cel As Range, wkbShape As Workbook, shtShape As Worksheet
Dim wkbOrig As Workbook, dateCol As Variant, matchRow As Variant
Dim rngSrch As Range
Set wkbOrig = ThisWorkbook
'best to include the file extension in the workbook name...
Set wkbShape = Workbooks("SHAPE Detailed coverage tracking WK" & _
WorksheetFunction.IsoWeekNum(Date))
Set shtShape = wkbShape.Worksheets("Detail coverage tracking")
'try to match the date...
dateCol = Application.Match(CLng(Date + 1), shtShape.Rows(5), 0)
If IsError(dateCol) Then 'date not matched?
MsgBox "Tomorrow's date not found on Row6 of " & shtShape.Name, vbExclamation
Exit Sub
End If
Set rngSrch = shtShape.Range("H6:H11")
For Each cel In wkbOrig.Sheets(2).Range("C3:C4,C9:C14").Cells
matchRow = Application.Match(Left(cel.Value, 10), rngSrch, 0)
If Not IsError(matchRow) Then
rngSrch.Cells(matchRow).EntireRow.Cells(dateCol).Resize(1, 14).Copy 'to where ?
End If
Next
End Sub

Index and Match in VBA

I don't know where I'm missing. I'm trying to provide the formula from a specific row to the last row in an excel table. I'm getting "unable to get the match property of the worksheetfunction class: 1004" error
when I use worksheetfunction.match and "Run time Error - 13 - Type Mismatch" when I use Application.match
Below is the code I have tried:
Sub PTO_Calculations()
Dim UBSht As Worksheet
Dim x As Long
'Variables for PTO Data
Dim PTOSht As Worksheet
Dim PTORows As Long, PTOCols As Long
Dim PTOOldRows As Long
Dim PTOWholeRange As Range
Dim PTOFirstColumnRange As Range
Dim PTOFirstRowRange As Range
'Variables for Table in UB Sht
Dim UBTable As ListObject
Dim UBTableRows As Long, UBTableCols As Long
Dim UBTableOldRows As Long
Set UBSht = ThisWorkbook.Sheets("UB - US & IND")
Set PTOSht = ThisWorkbook.Sheets("PTO Data")
Set UBTable = UBSht.ListObjects("UB_US_IND")
UBTableRows = UBTable.ListRows.Count + 1
UBTableCols = UBTable.ListColumns.Count
UBTableOldRows = UBTableRows - WorksheetFunction.CountIf(UBSht.Range("A:A"), Format(DateAdd("m", -1, Date), "mmmm - yyyy")) 'UBSht.Range("XFD1").Value
PTORows = PTOSht.Range("A" & Rows.Count).End(xlUp).Row
PTOCols = PTOSht.Cells(1, Columns.Count).End(xlToLeft).Column
Set PTOWholeRange = PTOSht.Range(Cells(1, 1).Address, Cells(PTORows, PTOCols).Address)
Set PTOFirstColumnRange = PTOSht.Range("A:A")
Set PTOFirstRowRange = PTOSht.Range(Cells(1, 1).Address, Cells(1, PTOCols).Address)
'I'M FACING ERROR IN THE BELOW STEP
Range(UBTable.Range(UBTableOldRows + 1, 6), UBTable.Range(UBTableRows, 6)).Value = _
Application.WorksheetFunction.Index(PTOWholeRange, Application.Match([#[Team Member Name]], PTOFirstColumnRange, 0), Application.Match([#Month], PTOFirstRowRange, 0))
end sub
Thank you for your help in advance.

Autofilter VBA, How i can check if the criteria doesn't exist?

I have 2 sheets is the CriteriaSheet and DataSheet that need to filter, which use the data in CriteriaSheet to fill in the Criterial argument of AutoFilter for filter data in DataSheet.
DataSheet
CriteriaSheet
My problem is, I want to know which Criteria is cannot find in the DataSheet. How do I know if the "Ant"(Criteria) doesn't exist in the DataSheet?
Function Filter_Function()
Dim Data_sh As Worksheet
Dim Filter_Criteria_Sh As Worksheet
Dim Output_sh As Worksheet
Set Data_sh = ThisWorkbook.Sheets("DataSheet")
Set Filter_Criteria_Sh = ThisWorkbook.Sheets("CriteriaSheet")
Set Output_sh = ThisWorkbook.Sheets("Output")
Output_sh.UsedRange.Clear
Data_sh.AutoFilterMode = False
Dim Emp_list() As String
Dim n, i As Integer
n = Application.WorksheetFunction.CountA(Filter_Criteria_Sh.Range("A:A")) - 2
ReDim Emp_list(n) As String
Dim R As String
For i = 0 To n
Emp_list(i) = Filter_Criteria_Sh.Range("A" & i + 2)
Next i
With Range("A1")
''get range before filter
Dim rngBefore As Range
Set rngBefore = Range(.Offset(1, 0), .Offset(1, 0).End(xlDown))
''filter
Data_sh.UsedRange.AutoFilter 2, Emp_list(), xlFilterValues
''get range after filter
On Error Resume Next
Dim rngAfter As Range
Set rngAfter = rngBefore.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
''check whether any cells matching criteria were found
If rngAfter Is Nothing Then
MsgBox "No found " & Emp_list()
'Exit Function
Else
Data_sh.UsedRange.Copy Output_sh.Range("A1")
End If
End With
Data_sh.AutoFilterMode = False
End Function
Could you please suggest? Thanks

VBA refering to a variable named range to move values

Code works as expected until the last line where I attempt to move values from one range to another at which point I'm getting a "run time error 1004", so must be doing something wrong.
the range "NewRng" does produce the correct string "$A$1883:$R$2105" which if entered manually into the last line (replacing the "NewRng" reference) it produces the correct results.
Thanks in advance
Dim NevwebLR As String
With Sheets("NevWeb file")
NevwebLR = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Dim DropShipLR As String
With Sheets("Drop Shipments")
DropShipLR = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Dim NevwebLR1 As String
NevwebLR1 = NevwebLR + 1
Dim dropshipglue As Long
dropshipglue = Val(NevwebLR) + Val(DropShipLR)
Dim rng1 As Range, rng2 As Range
Dim NewRng As Range
With ThisWorkbook.Sheets("Results")
Set rng1 = .Range("A" & NevwebLR1)
Set rng2 = .Range("R" & dropshipglue)
Set NewRng = .Range(rng1, rng2)
Debug.Print NewRng.Address
End With
Sheets("results").Range(NewRng).Value = Sheets("Drop Shipments").Range("A1:R" & DropShipLR).Value
You have your destination range already as Range-object, so change the last line to
NewRng.Value = Sheets("Drop Shipments").Range("A1:R" & DropShipLR).Value

Macro to delete column if match get error

I am searhing values in Col A of sheet "YYY" with values from Col A sheet"XXX" if a match is found delete the entire row of the matched cell on sheet"YYY"
I get object required on this line FindValues(i, 1).Row.Delete I have beeen tring to correct this for a while now but failing
Thanks
Edit: updated
Sub FindReplace_Updated_Blanks()
Dim FindValues As Variant, SearchValues As Variant
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim sLR As Long, tLR As Long, i As Long
Set wsSource = ThisWorkbook.Worksheets("XXX")
Set wsTarget = ThisWorkbook.Worksheets("YYY")
sLR = wsSource.Range("A" & wsSource.Rows.Count).End(xlUp).Row
tLR = wsTarget.Range("A" & wsSource.Rows.Count).End(xlUp).Row
SearchValues = wsSource.Range("A2:A" & sLR).Value
FindValues = wsTarget.Range("A2:A" & tLR).Value
For i = LBound(FindValues) To UBound(FindValues)
If Not IsError(Application.match(SearchValues(i, 1), wsTarget.Range("A2:A" & tLR), 0)) Then
wsTarget.Rows(i + 1).Delete
End If
Next i
End Sub
Change it for:
Sheets("YYY").Rows(i + 1).Delete
Since your range starts with a static "2" you don't need to use the range to find the row.

Resources