Searching non contiguous range for data to create different non contiguous range for next step in code

ebraatz

Board Regular
Joined
Feb 25, 2017
Messages
76
Not sure if I'm on the right track with this project or not, but keep getting a 'object variable or with block not set' on the highlighted line of code below. There are lots of variables defined and not yet used as I'm not finished with the code. Here's what I'm attempting to do:

Using two tables, each on a separate sheet: Database and Email

Each line of the Database contains information for one student with email addresses for two parents
- Headers for the parent emails are MEmail and FEmail - These columns are not next to each other.
I have a separate sub to take all unique emails from these two lists and put them into one list on my email list (Header= Email)
In the event that there are duplicates (i.e. multiple siblings in the school) I need to combine all the student names from Database table into one cell on Email table. I have a sub to do this (Sub JoinCells listed below) which requires the input of rngJoin(The cells to join that I'm trying to determine here) and rngDest(where the combined string goes - which should be a 'simple' match function). It is very likely that the multiple instances would be non contiguous. I suppose I could sort each list first, but I don't know if that would gain me much and it won't solve the problem with the error I'm getting.

The challenge ocurs when trying to find the correct row(s) of data in DatabaseTable associated with the EmailList. Match only works with contiguous ranges so I've created a Select Case block using range.find to search for the email in one of the lists and then using application.match for each case.

When I try to run this code, though, I keep getting the error 'Object variable or With Block not defined' on my Select Case line. As far as I can tell I've defined all the variables and I don't have a with block.

Any ideas why I'm getting this error?
Am I on the right track? Is there a simpler way to go about this?

Rich (BB code):
Sub CBEmail_Click()
    Dim Database As ListObject
    Dim EmailList As ListObject
    Dim dbHeaders As Range
    Dim eHeaders As Range
    Dim dbrMEmail As Range
    Dim dbrFEmail As Range
    Dim dbrClass As Range
    Dim dbrFullName As Range
    Dim erFirst As Range
    Dim erLast As Range
    Dim erNickname As Range
    Dim erEmail As Range
    Dim erClass As Range
    Dim cell As Range
    Dim MtchRng As Range
    Dim LookupRng As Range
    Dim MatchNum As Integer
    Dim dbvar As Variant
    Dim evar As Variant
    Dim i As Integer
    Dim m As Integer
    Dim arr As Variant
        
    'declare all range variables in database table
    Set Database = ActiveWorkbook.Sheets("database").ListObjects("Database")
    Set dbHeaders = Database.HeaderRowRange
    
    dbvar = Application.Match("MEmail", dbHeaders, 0)
    Set dbrMEmail = Database.ListColumns(dbvar).Range
        
    dbvar = Application.Match("FEmail", dbHeaders, 0)
    Set dbrFEmail = Database.ListColumns(dbvar).Range
    
    dbvar = Application.Match("Class", dbHeaders, 0)
    Set dbrClass = Database.ListColumns(dbvar).Range
    
    dbvar = Application.Match("Full Name", dbHeaders, 0)
    Set dbrFullName = Database.ListColumns(dbvar).Range
    
    'declare all range variables in email list table
    Set EmailList = ActiveWorkbook.Sheets("Email").ListObjects("EmailList")
    Set eHeaders = EmailList.HeaderRowRange
    
    evar = Application.Match("First", eHeaders, 0)
    Set erFirst = EmailList.ListColumns(evar).Range
    
    evar = Application.Match("Last", eHeaders, 0)
    Set erLast = EmailList.ListColumns(evar).Range
    
    evar = Application.Match("Nickname", eHeaders, 0)
    Set erNickname = EmailList.ListColumns(evar).Range
    
    evar = Application.Match("Email", eHeaders, 0)
    Set erEmail = EmailList.ListColumns(evar).Range
    
    evar = Application.Match("Class", eHeaders, 0)
    Set erClass = EmailList.ListColumns(evar).Range
    
    
    'fill table with emails
   ' Call Find_Unique_Emails
    
    'Fill first name
    
    'fill last name
    
    'fill nickname (joined 'full name')
    
    'fill class (Joined 'class')
        'Find range of cells to join
    'On Error GoTo nextStep
    For Each cell In Application.Intersect(erEmail, EmailList.DataBodyRange)
        'looking in FEmail List for cell value
        Select Case dbrFEmail.Find(what:=cell.Value)
            Case Nothing
                'if not found in FEmail look in MEmail
                Select Case dbrMEmail.Find(what:=cell.Value)
                    Case Nothing
                    'loop to next cell
                End Select
            'if found in mEmail list
            'Find number of matches
            MatchNum = Application.CountIf(dbrMEmail, cell.Value)
            'find row number for each
            m = Application.Match(cell.Value, dbrMEmail, 0)
            'determine rowrange of match
            Set MtchRng = Database.ListRows(m).Range
            'loop through all matches
                For i = 1 To MatchNum
                    'combine eacch match range into one range
                    MtchRng = Union(MtchRng, Database.ListRows(m).Range)
                Next i
            Case Else
            'if found in FEMail
            'Find number of matches
            MatchNum = Application.CountIf(dbrFEmail, cell.Value)
            'find row number for each
            m = Application.Match(cell.Value, dbrFEmail, 0)
            'determine rowrange of match
            Set MtchRng = Database.ListRows(m).Range
            'loop through all matches
                For i = 1 To MatchNum
                    'combine eacch match range into one range
                    MtchRng = Union(MtchRng, Database.ListRows(m).Range)
                Next i
                       
        End Select
    Next cell
    
    MsgBox MtchRng.Address
            
'errmsg:     MsgBox Err.Description
    
End Sub

Sub JoinCells(rngJoin As Range, rngDest As Range)
    'joins cells from selected range into the selected cell
    '-----range must be a SINGLE column or SINGLE row
    Dim test As Integer
    Dim JoinType As String
    Dim JoinNum As Integer
    Dim Temp As String
    Dim i As Integer
    
    'count number of rows to determine direction of range
    test = rngJoin.Rows.Count
    
    'determine if range is a row or column, number of cells in range to join
    Select Case test
        Case 1
            JoinType = "Columns"
            JoinNum = rngJoin.Columns.Count
        Case Is > 1
            JoinType = "Rows"
            JoinNum = test
        Case Else
            MsgBox "Range to join not selected"
            Exit Sub
    End Select
    
    'join cell values
    Select Case JoinType
        Case "Columns"
            Temp = rngJoin.Columns(1).Value
            For i = 2 To JoinNum
                Temp = Temp & "," & rngJoin.Columns(i).Value
            Next i
        Case "Rows"
            Temp = rngJoin.Rows(1).Value
            For i = 2 To JoinNum
                Temp = Temp & "," & rngJoin.Rows(i).Value
            Next i
    End Select
    
    'set range value as joined cell values
    rngDest.Value = Temp
        
End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
ClassFull NameMFirstMLastMEmailFFirstFLastFEMail
RedJohnny SmithJaneSmithjane@email.comJohnSmithjohn@email.com
BlueSarah LongSheilaLongsheila@email.com
YellowJacob SmithJaneSmithjane@email.comJohnSmithjohn@email.com
PurpleJulie SmithJaneSmithjane@email.comJohnSmithjohn@email.com
NavySuzy WrightLauraWrightlaura@email.comMikeWrightmike@email.com
BlueChris FriendLisaFriendlisa@email.comJoshFriendjosh@email.com

<tbody>
</tbody>
Above is a sample of the Database Table with the columns involved. Actual table has almost 70 columns.

Below is a sample of the Email List table after the Unique List is made.

FirstLastNicknameEmailYearClassDistributionList
jane@email.com2017.2018
john@email.com2017.2018
sheila@email.com2017.2018
laura@email.com2017.2018
mike@email.com2017.2018
lisa@email.com2017.2018
josh@email.com2017.2018

<tbody>
</tbody>

So what I need to do is for each email listed in the Email List, I need to column 'First' and 'Last' with the First and Last name associated with it. (i.e. MFirst, MLast goes with MEmail). I intend to use Match and Offset for this.

My question above pertains to the Nickname and Class Columns. Nickname is the email contact field where the child(ren)'s name(s) are placed so for jane@email.com and John@email.com the Nickname field should be " John Smith, Jacob Smith, John Smith". And similarly the Class field should be "Red, Yellow, Purple".

The Sub JoinCells that I shared above will take the range of cells to be joined and concatenate the values. I just need to find the cells.

So if, in the Database Table, assuming Class is in cell A1, The Range I would need for the Smith's would be Range("a2, a4, a5").

My methodology was to use application.match to find the row location of the email in database, set the row range and fine the intersect of the row range(s) from match and the Class Column.

My struggle has come from the fact that the two email lists are not next to each other and Match requires a contiguous range.
 
Last edited:
Upvote 0
I think I solved my problem. Changed my Select Case to an If..Then..Else statements. Lets see if it continues to work as I get the rest of the code in! If interested, this is what I have: (declarations are the same as above)
Code:
For Each cell In Application.Intersect(erEmail, EmailList.DataBodyRange) ' create function to find
        'looking in FEmail List for cell value                               ' source range?
        If dbrFEmail.Find(what:=cell.Value) Is Nothing Then
            'if not found in FEmail look in MEmail
                If dbrMEmail.Find(what:=cell.Value) Is Nothing Then
                'loop to next cell
                End If
            'if found in mEmail list
            'Find number of matches
            MatchNum = Application.CountIf(dbrMEmail, cell.Value)
            'find row number for each
            m = Application.Match(cell.Value, dbrMEmail, 0)
            'determine rowrange of match
            Set MtchRng = Database.ListRows(m).Range
            'loop through all matches
                For i = 1 To MatchNum
                    'combine eacch match range into one range
                    MtchRng = Union(MtchRng, Database.ListRows(m).Range)
                Next i
            'evaluate next cell
            Else
            'if found in FEMail
            'Find number of matches
            MatchNum = Application.CountIf(dbrFEmail, cell.Value)
            'find row number for each
            m = Application.Match(cell.Value, dbrFEmail, 0)
            'determine rowrange of match
            Set MtchRng = Database.ListRows(m).Range
            'loop through all matches
                For i = 1 To MatchNum
                    'combine eacch match range into one range
                    MtchRng = Union(MtchRng, Database.ListRows(m).Range)
                Next i
            'evaluate next cell
        End If
        MsgBox MtchRng.Address
    Next cell
 
Upvote 0

Forum statistics

Threads
1,214,594
Messages
6,120,436
Members
448,964
Latest member
Danni317

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top