Match in Array

[cha]

Hi,
I want to loop through a set of data. For each activecell.value, search for it in a defined string array. If there is a match, then do something with that activecell. Here are some more specifics.

My array: courses = ("a","b","c","d","e")

My data:
<table class="cms_table" width="146"><tbody><tr><td style="vertical-align: top;">date
</td><td style="vertical-align: top;">course
</td><td style="vertical-align: top;">days
</td></tr><tr class="cms_table_tr" valign="top"><td class="cms_table_td">08/08/2011</td> <td class="cms_table_td">a</td> <td class="cms_table_td">2</td> </tr> <tr class="cms_table_tr" valign="top"><td class="cms_table_td">09/08/2011</td> <td class="cms_table_td">b</td> <td class="cms_table_td">1</td> </tr> <tr class="cms_table_tr" valign="top"><td class="cms_table_td">09/08/2011</td> <td class="cms_table_td">z</td> <td class="cms_table_td">1</td> </tr> <tr class="cms_table_tr" valign="top"><td class="cms_table_td">09/08/2011</td> <td class="cms_table_td">a</td> <td class="cms_table_td">5</td> </tr> <tr class="cms_table_tr" valign="top"><td class="cms_table_td">10/08/2011</td> <td class="cms_table_td">z</td> <td class="cms_table_td">2</td> </tr> </tbody></table>

I want to make a new sheet, which is a condensed version the table above. It only contains the data for the courses defined in the array.

VB:

Sub x() 'array courses stored codecodecode
ActiveSheet.Range("A2").Activate Do Until IsEmpty(ActiveCell) On Error Goto HERE m = Application.WorksheetFunction.Match(ActiveCell.Value, courses, 0) MsgBox "no problems " & m Rows(ActiveCell.Row).Copy Worksheets("Courses").Activate ActiveCell.PasteSpecial ActiveCell.Offset(1, 0).Select Worksheets("data").Activate HERE: ActiveCell.Offset(1, 0).Activate Loop End Sub



It correctly ignores the first error, which is the first 'z'. Once it gets the the second z, I get run-time error '1004': unable to get the Match property.
Why am I getting this error?

 

[hiker95]

cha,


Welcome to the MrExcel forum.


Sample worksheets before the macro:

Excel Workbook
	A	B	C
1	date	course	days
2	8/8/2011	a	2
3	9/8/2011	b	1
4	9/8/2011	z	1
5	9/8/2011	a	5
6	10/8/2011	z	2
7
Data

Excel Workbook
	A	B	C
1	Date	course	days
2
3
4
5
Courses

After the macro:

Excel Workbook
	A	B	C
1	Date	course	days
2	8/8/2011	a	2
3	9/8/2011	b	1
4	9/8/2011	a	5
5
Courses

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Option Base 1
Sub GetCourses()
' hiker95, 08/16/2011
' http://www.mrexcel.com/forum/showthread.php?t=572237
Dim courses()
Dim LR As Long, a As Long, c As Long, NR As Long
Application.ScreenUpdating = False
courses = Array("a", "b", "c", "d", "e")
With Worksheets("Data")
  LR = .Cells(Rows.Count, 1).End(xlUp).Row
  For a = 2 To LR Step 1
    c = 0
    On Error Resume Next
    c = Application.Match(.Range("B" & a), courses, 0)
    On Error GoTo 0
    If c > 0 Then
      NR = Worksheets("Courses").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
      .Range("A" & a).Resize(, 3).Copy Worksheets("Courses").Range("A" & NR)
    End If
  Next a
End With
Worksheets("Courses").Activate
Application.ScreenUpdating = True
End Sub

Then run the GetCourses macro.

 

[hiker95]

cha,

With your macro code (I do not want to guess), what is the worksheet referred to in this line of code?

ActiveSheet.Range("A2").Activate

I will then step thru the code to see where the problem is.

 

[cha]

hiker95,

Thanks for your response.

That line refers to the "data" worksheet. I changed the code to Application.match instead of Application.WorksheetFunction.Match (not sure what the difference is). I now get run-time error 13: type mismatch once I hit the second 'z'.

Here's what I have so far:

Sub globalclasses()

    Dim count As Integer, courses() As String, str As String, title As String, m As Variant

[INDENT]        ' pseudocode for courses(0 array
[/INDENT]
    Worksheets("data").Activate
    ActiveSheet.Range("B2").Activate
    Do Until IsEmpty(ActiveCell)
[INDENT]On Error GoTo HERE
[/INDENT]        m = Application.Match(ActiveCell.Value, courses, 0)

        MsgBox "no problems   " & m

        Rows(ActiveCell.Row).Copy
        Worksheets("Courses").Activate
        ActiveCell.PasteSpecial
        ActiveCell.Offset(1, 0).Select
        Worksheets("data").Activate
HERE:
        ActiveCell.Offset(1, 0).Activate
    Loop
    

End Sub

 

[cha]

UPDATE!

I got it to work using if iserror(). I replaced the loop with:

    Do Until IsEmpty(ActiveCell)
       m = Application.Match(ActiveCell.Value, courses, 0)
       If Not IsError(m) Then
            MsgBox "no problems   " & m
            Rows(ActiveCell.Row).Copy
            Worksheets("Courses").Activate
            ActiveCell.PasteSpecial
            ActiveCell.Offset(1, 0).Select
            Worksheets("data").Activate
       End If
        ActiveCell.Offset(1, 0).Activate
    Loop

However, for my knowledge, I still would like to understand why the above didn't work. Also what is the difference between Application.match and Application.WorksheetFunction.match?

 

[hiker95]

cha,

Congratulations!

Also what is the difference between Application.match and Application.WorksheetFunction.match?

Works the same, but is just shorter.


Your original code assumes that the active cell on both worksheets has already been set.


See the instructions in the code:

Option Explicit
Sub x_V2() 'array courses stored codecodecode
Dim courses(), m As Long
courses = Array("a", "b", "c", "d", "e")

'With you original code we do not know where the active cells are
'  in either of the two worksheets.
'So, lets set the activecells:
Worksheets("Courses").Activate
ActiveSheet.Range("A2").Activate

' The next line of code is selecting a date, not a course,
'  and it should be on worksheet Data
'ActiveSheet.Range("A2").Activate
Worksheets("Data").Activate
ActiveSheet.Range("B2").Activate

Do Until IsEmpty(ActiveCell)
  
  m = 0
  
  On Error Resume Next
  m = Application.Match(ActiveCell.Value, courses, 0)
  
  'On error reset the error level
  On Error GoTo 0
  
  If m = 0 Then GoTo HERE
  
  MsgBox "no problems " & m
  Rows(ActiveCell.Row).Copy
  Worksheets("Courses").Activate
  
  'The next line of code assumes that the active cell
  '  on the first pass of the macro,
  '  on worksheet Courses is cell A2
  ActiveCell.PasteSpecial
  ActiveCell.Offset(1, 0).Select

HERE:
Worksheets("Data").Activate
ActiveCell.Offset(1, 0).Activate
Loop

Worksheets("Courses").Activate
End Sub

 

[cha]

Thank you!

 

[hiker95]

cha,

You are very welcome.

Glad I could help.

Come back anytime.