Highline Excel Class 43: MATCH function

Hi in below stated code i do get this error:
Unable to Match property of Worksheet class function.
It seems I made everything right, but I cannot figure out why this message appears. Hope you can find out the problem...

Code:

Private Sub StudentButton_Click()
    Dim DateField As Range, ResultTable As Range
    Dim StartDay As Date, EndDay As Date
    Dim lRow As Long, lColumn As Long
    Dim sDayPos As Long, eDayPos As Long
    Dim StartRow As Integer, StartColumn As Integer
    Dim MyMonth As Integer, MyYears As Integer, lDate As Integer

    StartRow = Range("FirstCell").Row
    StartColumn = Range("FirstCell").Column

    Set ResultTable = Range("ResultTable")
    Set DateField = Sheets(2).Range("Dates")
    
    'Getting Last column number
    With Range(StartRow & ":" & StartRow)
         lColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With

    For MyYears = 1 To lColumn - StartColumn
        For MyMonth = 1 To 12

----------------------------------------- SOME PART OF CODE BETWEEN ------------------------------

            'Getting positions for Fist day and last day of a month in Datafield Range
             With WorksheetFunction
                sDayPos = .Match(StartDay, DateField, 0)   <<<<<<< CAUSES ERROR
                eDayPos = .Match(EndDay, DateField, 0)    <<<<<<< CAUSES ERROR
            End With 

        MsgBox sDayPos & " and " & eDayPos
        Next MyMonth
    Next MyYears
End Sub

I'm trying to use a class for defining a set of data and also to get values from two different ways, a database and a spreadsheet. Let me explain with an example.

I created a class called clsData with the following code:

Public conn As ADODB.Connection
Private p_isin As String
Private p_tick As String

Public Property Let isin(myvalue As String)
p_isin = myvalue
End Property
Public Property Get isin() As String
isin = p_isin
End Property
Public Property Let tick(myvalue As String)
p_tick = myvalue
End Property
Public Property Get tick() As String
tick = p_tick
End Property


I inserted a public function inside that class, in order to retrieve the data in the two mentioned ways:

Public Function GetData(myvalue As String, DB As Boolean) As clsData
Dim rs As ADODB.Recordset
Dim sql As String
Dim c As Range
Dim myData As clsData
Set myData = New clsData

If DB Then
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseServer
sql = "SELECT * FROM dbData WHERE isin='" & myvalue & "'"
rs.Open sql, conn

If Not rs.EOF Then
myData.isin = rs("isin")
myData.tick = rs("tick")
End If
rs.Close
Else
With ActiveSheet
Set c = .Range("A:A").Find(myvalue, LookAt:=xlWhole)
If Not c Is Nothing Then
myData.isin = .Cells(c.Row, 1)
myData.tick = .Cells(c.Row, 2)
End If
End With
End If
GetData = myData
End Function

All that code goes into clsData. Now I add a standard mode with this code:

Public Function GetClassData() As clsData
Set GetClassData = New clsData
End Function

Sub myTest()
Dim AllData As clsData
Set AllData = New clsData
AllData = GetClassData.GetData("FI0009000681", False)
End Sub

The first function is in order to access the class and the function inside
The routine myTest is trying to retrieve the data I need

I get an error in last line of the function: "GetData = myData". Error message window says "Object variable or block With not established" (actually it is a translation of my current Excel version)

Anybody knows what is wrong with this code?
I can send the whole code to anybody who can help

JC

I'm getting the error: "Unable to get the Match Property of the WorksheetFunction class" and I'm not sure why. I've seen several other posts with this issue, however have not been able to find a solution. I attempted to use an IsError Function to see if the Match function just wasn't finding the string in the range, however when I get this error message after it reads the Iserror line. I'm using a specific serach "balloki" just to simplify the function but will be using the n() strings. When I CTRL + F "Balloki" in the worksheet, it does find it, so I'm confused. It does find the range, when I do range1.select in the code. Please help!

Code:

Private Sub CommandButton1_Click()
On Error GoTo errmsg
ActiveWorkbook.Sheets(1).Activate
Dim n(3) As String
Dim t As Integer
Dim rownum As Integer
Dim range1 As Range
Dim name1 As String
Set range1 = ActiveWorkbook.Sheets(1).Range("A1", "P300")
t = 0
n(0) = "Baglan Bay"
n(1) = "balloki"
n(2) = "barcelona"
n(3) = "BoZ, Bergen op Zoom"
 
name1 = "balloki"
range1.Select
 
If IsError(Application.WorksheetFunction.Match(name1, range1)) Then
MsgBox "yes"
Else
MsgBox "no"
End If
 
Do While t < 31
 
rownum = Application.WorksheetFunction.Match(name1, range1, 0)
MsgBox rownum
MsgBox "after response"
t = t + 1
Loop
UserForm1.Hide
endloop:
End
 
errmsg:
MsgBox Err.Description
GoTo endloop
 
End Sub

Hi there,
I have a macro that works on its own. A selection is made from a validation list and information from another sheet gets copied.
Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim x1 As Double
 
If Target.Address = "$A$1" Then
x1 = WorksheetFunction.Match(Target.Value, Sheets("1").Range("A:A"), 0)
Sheets("1").Rows(x1).Resize(1, Rows(x1).Columns.Count - 1).Offset(0, 0).Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A3")
End If
End Sub

But I need to update to get information from multiple sheets. I did, and apologies before you read this and roll your eyes, think that if you increment x1 and the source and target location it would pull from multiple sheets, but it isnt, I get this error:
Unable to get the Match property of the WorksheetFunction class

Any ideas?
Here is the macro and again apologies for the crudeness of it.
Code:

 
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim x1 As Double
Dim x2 As Double
Dim x3 As Double
Dim x4 As Double
Dim x5 As Double
Dim x6 As Double
 
If Target.Address = "$A$1" Then
x1 = WorksheetFunction.Match(Target.Value, Sheets("1").Range("A:A"), 0)
Sheets("1").Rows(x1).Resize(1, Rows(x1).Columns.Count - 1).Offset(0, 0).Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A3")
End If
 
If Target.Address = "$A$1" Then
x2 = WorksheetFunction.Match(Target.Value, Sheets("1a").Range("A:A"), 0)
Sheets("1a").Rows(x1).Resize(1, Rows(x1).Columns.Count - 1).Offset(0, 0).Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A4")
End If
 
If Target.Address = "$A$1" Then
x3 = WorksheetFunction.Match(Target.Value, Sheets("2").Range("A:A"), 0)
Sheets("2").Rows(x1).Resize(1, Rows(x1).Columns.Count - 1).Offset(0, 0).Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A7")
End If
 
If Target.Address = "$A$1" Then
x4 = WorksheetFunction.Match(Target.Value, Sheets("2a").Range("A:A"), 0)
Sheets("2a").Rows(x1).Resize(1, Rows(x1).Columns.Count - 1).Offset(0, 0).Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A8")
End If
 
If Target.Address = "$A$1" Then
x5 = WorksheetFunction.Match(Target.Value, Sheets("3").Range("A:A"), 0)
Sheets("3").Rows(x1).Resize(1, Rows(x1).Columns.Count - 1).Offset(0, 0).Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A11")
End If
 
If Target.Address = "$A$1" Then
x6 = WorksheetFunction.Match(Target.Value, Sheets("3a").Range("A:A"), 0)
Sheets("3a").Rows(x1).Resize(1, Rows(x1).Columns.Count - 1).Offset(0, 0).Copy
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("A12")
End If

End Sub

hello,

i'm trying to write a macro that colors in cells in a table if the number in the cell matches with a number in another column, but i get run time error '1004.

any idea? i tried so many things but it seems that i can't re-use range() in a for loop? can someone please help me??????

exl044

Code:

Sub colorMyCell()
        
    For i = 2 To 31
        
        For j = 6 To 15
            
            MyCellValue = Cells(i, j).Value
            
            
            If (Application.WorksheetFunction.IsNA(Application.WorksheetFunction.Match(MyCellValue, Range("A2:A31"))) <> False) Then
                Cells(i, j).Interior.ColorIndex = 38    'colors cell with this color if the value matches column A values
            
            End If
            
       
            If (Application.WorksheetFunction.IsNA(Application.WorksheetFunction.Match(MyCellValue, Range("B2:B31"))) <> False) Then
                Cells(i, j).Interior.ColorIndex = 40  'colors cell with this color if the value matches column B values
                
            End If
            
            If (Application.WorksheetFunction.IsNA(Application.WorksheetFunction.Match(MyCellValue, Range("C2:C31")))) Then
                Cells(i, j).Interior.ColorIndex = 42    'colors cell with this color if the value matches column C values
                
            End If
            
            If (Application.WorksheetFunction.IsNA(Application.WorksheetFunction.Match(MyCellValue, Range("D2:D31")))) Then
                Cells(i, j).Interior.ColorIndex = 44    'colors cell with this color if the value matches column D values
                
            End If
            
        Next j
            
    Next i

End Sub

So I created this code for some dummy data and it worked seamlessly. Now that I've copied it to the real workbook I get an run-time error.

I've looked at prior threads that have solved this problem and it doesn't seem to work for me.

Could you help me out?
Code:

Sub updateDept()

    Range("A1").EntireColumn.Insert (xlLeft)

    ICN_Offset = Application.WorksheetFunction.Match("ICN", Range("A1:Z1"), 0) - 1
    KO_Offset = Application.WorksheetFunction.Match("KO", Range("A1:Z1"), 0) - 1
    
    Range("A2", Range("B2").End(xlDown).Offset(0, -1)).FormulaR1C1 = _
            "=RC[" & ICN_Offset & "]&RC[" & KO_Offset & "]"
            
    Range("A2").Select
    Do
    With Worksheets("All").Range("a1:a" & Worksheets("All").Range("B2").End(xlDown).Row)
    Set c = .Find(ActiveCell.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        ActiveCell.Offset(0, 9).Value = "Rec"
        ActiveCell.EntireRow.Hidden = True
    End If
    ActiveCell.Offset(1, 0).Select
    End With
    Loop Until ActiveCell.Value = ""
  Range("A1").EntireColumn.Delete
  
End Sub

Sub prepAll()

    Application.ScreenUpdating = False
    Application.StatusBar = "Processing"
    

    Range("A1").EntireColumn.Insert (xlLeft)
    
    ICN_Offset = WorksheetFunction.Match("ICN", Range("A1:Z1"), 0) - 1
    KO_Offset = WorksheetFunction.Match("KO", Range("A1:Z1"), 0) - 1
   
    
    Range("A2", Range("B2").End(xlDown).Offset(0, -1)).FormulaR1C1 = _
            "=RC[" & ICN_Offset & "]&RC[" & KO_Offset & "]"
    
    ActiveSheet.Name = "All"
    
    
    For Each CodeSheet In ActiveWorkbook.Sheets
        If Not CodeSheet.Name = "All" Then
            CodeSheet.Activate
            Call updateDept
        End If
    Next CodeSheet
    Sheets("All").Select
    Range("A1").EntireColumn.Delete
    
    Application.ScreenUpdating = True
    Application.StatusBar = False
End Sub

I have stored some values in an array like as below:

Code:

 Tableno(1) ="2"

I have to find out the row number containing the value stored in the above array in A column and delete that row. I am using the following function to find out the row number, but I am getting the " Run-time error '1004': Unable to get the Match property of Worksheetfunction class".

Code:

dtbl = Application.WorksheetFunction.Match(" & CStr(Tableno(1)) & ", Range("A1:A50000"), 0)
Rows("dtbl:dtbl").Select
Selection.Delete Shift:=xlUp

Can any body help me what is the problem with the above code?

Sincerely
Krish T

I have got 2 worksheets in my excel file. One is the ordering database which allows colleagues to enter the data every time when they are ordering stocks, e.g. stock ID number, quantity, Payroll number, etc.. and the ordering note (print it out and send it to warehouse) is the other worksheet. My boss asked me to link the two database together, does anyone knows how to do this by combining the match and index function. His expectation is automatically fill in the whole ordering note by just entering a reference number into a box. Anyone can help? Many thanks indeed^^

Any suggestions to work around the sum error?

Quote:

Runtime Error '1004'
unable to locate the sum property of the worksheetfunction class

Code:

Public Function CalcSheet()
Dim NoSales(0 To 11) As Range
Dim DriveOffs(0 To 11) As Range
Dim Voids(0 To 11) As Range
Dim Shortages(0 To 11) As Range
Dim tNoSales As Integer
Dim tDriveOffs As Currency
Dim tVoids As Currency
Dim tShortages As Currency
Dim X As Integer
Dim NSc As Integer
Dim DOc As Integer
Dim VOc As Integer
Dim SHc As Integer
Dim aNoSales As Integer
Dim aDriveOffs As Currency
Dim aVoids As Currency
Dim aShortages As Currency

    'Initialize Total and Average Variables
    aNoSales = 0
    aDriveOffs = 0
    aVoids = 0
    aShortages = 0
    tNoSales = 0
    tDriveOffs = 0
    tVoids = 0
    tShortages = 0

    'Populate Object Arrays
    Set NoSales(0) = Worksheets(1).Range("B3:B33")
    Set NoSales(1) = Worksheets(1).Range("F3:F33")
    Set NoSales(2) = Worksheets(1).Range("J3:J33")
    Set NoSales(3) = Worksheets(1).Range("N3:N33")
    Set NoSales(4) = Worksheets(1).Range("R3:R33")
    Set NoSales(5) = Worksheets(1).Range("V3: V33")
    Set NoSales(6) = Worksheets(1).Range("Z3:Z33")
    Set NoSales(7) = Worksheets(1).Range("AD3:AD33")
    Set NoSales(8) = Worksheets(1).Range("AH3:AH33")
    Set NoSales(9) = Worksheets(1).Range("AL3:AL33")
    Set NoSales(10) = Worksheets(1).Range("AP3:AP33")
    Set NoSales(11) = Worksheets(1).Range("AT3:AT33")
    
    Set DriveOffs(0) = Worksheets(1).Range("C3:C33")
    Set DriveOffs(1) = Worksheets(1).Range("G3:G33")
    Set DriveOffs(2) = Worksheets(1).Range("K3:K33")
    Set DriveOffs(3) = Worksheets(1).Range("O3:O33")
    Set DriveOffs(4) = Worksheets(1).Range("S3:S33")
    Set DriveOffs(5) = Worksheets(1).Range("W3:W33")
    Set DriveOffs(6) = Worksheets(1).Range("AA3:AA33")
    Set DriveOffs(7) = Worksheets(1).Range("AE3:AE33")
    Set DriveOffs(8) = Worksheets(1).Range("AI3:AI33")
    Set DriveOffs(9) = Worksheets(1).Range("AM3:AM33")
    Set DriveOffs(10) = Worksheets(1).Range("AQ3:AQ33")
    Set DriveOffs(11) = Worksheets(1).Range("AU3:AU33")
    
    Set Voids(0) = Worksheets(1).Range("D3:D33")
    Set Voids(1) = Worksheets(1).Range("H3:H33")
    Set Voids(2) = Worksheets(1).Range("L3:L33")
    Set Voids(3) = Worksheets(1).Range("P3:P33")
    Set Voids(4) = Worksheets(1).Range("T3:T33")
    Set Voids(5) = Worksheets(1).Range("X3:X33")
    Set Voids(6) = Worksheets(1).Range("AB3:AB33")
    Set Voids(7) = Worksheets(1).Range("AF3:AF33")
    Set Voids(8) = Worksheets(1).Range("AJ3:AJ33")
    Set Voids(9) = Worksheets(1).Range("AN3:AN33")
    Set Voids(10) = Worksheets(1).Range("AR3:AR33")
    Set Voids(11) = Worksheets(1).Range("AV3:AV33")
        
    Set Shortages(0) = Worksheets(1).Range("E3:E33")
    Set Shortages(1) = Worksheets(1).Range("I3:I33")
    Set Shortages(2) = Worksheets(1).Range("M3:M33")
    Set Shortages(3) = Worksheets(1).Range("Q3:Q33")
    Set Shortages(4) = Worksheets(1).Range("U3:U33")
    Set Shortages(5) = Worksheets(1).Range("Y3:Y33")
    Set Shortages(6) = Worksheets(1).Range("AC3:AC33")
    Set Shortages(7) = Worksheets(1).Range("AG3:AG33")
    Set Shortages(8) = Worksheets(1).Range("AK3:AK33")
    Set Shortages(9) = Worksheets(1).Range("AO3:AO33")
    Set Shortages(10) = Worksheets(1).Range("AS3:AS33")
    Set Shortages(11) = Worksheets(1).Range("AW3:AW33")
    
    For X = 0 To 11 Step 1

        If Application.WorksheetFunction.Sum(NoSales(X)) > 0 Then 'Check for no data
            NSc = NSc + Application.WorksheetFunction.Count(NoSales(X)) 'Count number of data entries
            tNoSales = tNoSales + Application.WorksheetFunction.Sum(NoSales(X)) 'Sum data
        End If
    
    Next X

    For X = 0 To 11 Step 1
        
        If Application.WorksheetFunction.Sum(DriveOffs(X)) > 0 Then 'Check for no data
            DOc = DOc + Application.WorksheetFunction.Count(DriveOffs(X)) 'Count number of data entries
            tDriveOffs = tDriveOffs + Application.WorksheetFunction.Sum(DriveOffs(X)) 'Sum data
        End If
    
    Next X

    For X = 0 To 11 Step 1

        If Application.WorksheetFunction.Sum(Voids(X)) > 0 Then 'Check for no data
            VOc = VOc + Application.WorksheetFunction.Count(Voids(X)) 'Count number of data entries
            tVoids = tVoids + Application.WorksheetFunction.Sum(Voids(X)) 'Sum data
        End If
    
    Next X

    For X = 0 To 11 Step 1

        If Application.WorksheetFunction.Sum(Shortages(X)) > 0 Then 'Check for no data
            SHc = SHc + Application.WorksheetFunction.Count(Shortages(X)) 'Count number of data entries
            tShortages = tShortages + Application.WorksheetFunction.Sum(Shortages(X)) 'Sum data
        End If
    
    Next X

    'Error Check before Dividing for Average
    If (tNoSales > 0) And (NSc > 0) Then aNoSales = tNoSales / NSc
    If (tDriveOffs > 0) And (DOc > 0) Then aDriveOffs = tDriveOffs / DOc
    If (tVoids > 0) And (VOc > 0) Then aVoids = tVoids / VOc
    If (tShortages > 0) And (SHc > 0) Then aShortages = tShortages / SHc

    'Insert Averages
    Worksheets(1).Range("B37").Value = aNoSales
    Worksheets(1).Range("C37").Value = aDriveOffs
    Worksheets(1).Range("D37").Value = aVoids
    Worksheets(1).Range("E37").Value = aShortages
    
    'Insert Totals
    Worksheets(1).Range("B38").Value = tNoSales
    Worksheets(1).Range("C38").Value = tDriveOffs
    Worksheets(1).Range("D38").Value = tVoids
    Worksheets(1).Range("E38").Value = tShortages
    
    'Release Objects
    Set NoSales(0) = Nothing
    Set NoSales(1) = Nothing
    Set NoSales(2) = Nothing
    Set NoSales(3) = Nothing
    Set NoSales(4) = Nothing
    Set NoSales(5) = Nothing
    Set NoSales(6) = Nothing
    Set NoSales(7) = Nothing
    Set NoSales(8) = Nothing
    Set NoSales(9) = Nothing
    Set NoSales(10) = Nothing
    Set NoSales(11) = Nothing
    
    Set DriveOffs(0) = Nothing
    Set DriveOffs(1) = Nothing
    Set DriveOffs(2) = Nothing
    Set DriveOffs(3) = Nothing
    Set DriveOffs(4) = Nothing
    Set DriveOffs(5) = Nothing
    Set DriveOffs(6) = Nothing
    Set DriveOffs(7) = Nothing
    Set DriveOffs(8) = Nothing
    Set DriveOffs(9) = Nothing
    Set DriveOffs(10) = Nothing
    Set DriveOffs(11) = Nothing
    
    Set Voids(0) = Nothing
    Set Voids(1) = Nothing
    Set Voids(2) = Nothing
    Set Voids(3) = Nothing
    Set Voids(4) = Nothing
    Set Voids(5) = Nothing
    Set Voids(6) = Nothing
    Set Voids(7) = Nothing
    Set Voids(8) = Nothing
    Set Voids(9) = Nothing
    Set Voids(10) = Nothing
    Set Voids(11) = Nothing
        
    Set Shortages(0) = Nothing
    Set Shortages(1) = Nothing
    Set Shortages(2) = Nothing
    Set Shortages(3) = Nothing
    Set Shortages(4) = Nothing
    Set Shortages(5) = Nothing
    Set Shortages(6) = Nothing
    Set Shortages(7) = Nothing
    Set Shortages(8) = Nothing
    Set Shortages(9) = Nothing
    Set Shortages(10) = Nothing
    Set Shortages(11) = Nothing

End Function

Hello,

How do you pass an object to a class or function.

I've tried this:

Class

Code:

Private objListBox As listbox
Private intY As Long

Public Function items()
    For intY = 0 To objListBox.ListCount - 1
        If objListBox.Select(intY) = True Then
            MsgBox objListBox.List(intY)
        End If
    Next intY
End Function

Public Property Set SetObj(ByVal NewObj As listbox)
    Set objListBox = NewObj
End Property

Module

Code:

Option Explicit

Private Sub cmdRow_Click()

    Dim GetList As Class1
    
    GetList.SetObj = lstpvtdata ' This is a listbox in a from
    
    GetList.items
    
End Sub

But get an invalid use of property error.