Identify parts of text/numeric within a string of data in a cell and return multiple columns of data to new sheet

Maggie Barr

Board Regular
Joined
Jan 28, 2014
Messages
188
I am trying to identify parts of text/numeric within a string of data in a cell and if it is found return a new row (new sheet) with identifiers from multiple columns in new sheet as described below.
I am using a PC with Excel 2010. I approach this request for help with a humble, hanging head. I know I can do this manually with a variety of steps to make it a little faster, but I just feel/know that there must be an excel GURU out there that may be able to help me. I have a feeling it would be a rather lengthy VBA code that I yet to have the skills to even pretend to approach. Even if you can’t solve my puzzle any advice would be greatly appreciated.
Here is the puzzle:
In column A I have plant species names, and in columns B through N are townships (1-13), and within those cells are vouchers, observations, and references, sometimes one, sometimes multiple all separated/enclosed by().
A portion of the sheet would look like this:
Species
Township1
Township2
Township3
Abies balsamea

X (BFP 2013) (BFP 2012) (Lortie et al. 1996) (Hudson 1985)

X (BFP 2013) (Burns 1982 [1,2,3,4,S,M,H,C]) (Rooney 1984 [5,6,11,S,M,H,C])

X (BFP 2013) (BFP 2012) (Lortie et al. 1996) (Hudson 1985) (May & Davis 1978)

Acer pensylvanicum

X (BFP 2013) (Lortie et al. 1996) (Burns 1982 [Horse Mtn. Rare Plant Station-one of 3 known Maine stations for plant])

X (BFP 2013) (BFP 2012) (Lortie et al. 1996) (Hudson 1985)

X (BFP 2013) (Burns 1982 [1,2,3,4,S,M,H])(Rooney 1984 [5,6,11,S,M,H])

Acer rubrum

X (BFP 2013)

X (BFP 2013) (BFP 2012) (Lortie et al. 1996) (Hudson 1985)

X (BFP 2013) (Lortie et al. 1996) (Burns 1982 [1,2,3,4,S,M,C])(Rooney 1984 [5,6,11,S,M,H])


<tbody>
</tbody>

What I would like to do is produce a table where species and township are repeated in columns A and B for the presence of each of the following REFERENCES (ignore the other stuff) within a cell: The trick here is that I need it to search for a key ‘part’ (Name and Year – see below) of a reference within () because sometimes there are other details within the “(reference)” and return the Reference ID (Column A in table below). Please note it cannot check only for name because some authors have more than one year of publication (Dibble has three), and there are separate publications from the same year. What is important is that each cell needs to be checked for all authors (I think as a separate command) so it will include all references within the cell for output (see below).
Authors table:
14
Burns 1982
6
Clark 1998
9
Cogbill 1990
1
DeWolf 2012
8
Dibble 1994
3
Dibble 2007
10
Dibble 1990
17
Fernald 1901
18
Hansen 1938
13
Hansen 1983
11
Hudson 1985
7
Lortie 1996
15
May 1978
12
Rooney 1984
5
Small 2004
16
Stebbins 1927
4
Weber 2005
2
Weihrauch 2010

<tbody>
</tbody>

SOOO, the resulting output table for species one of the first table would look like this:
Species
Township
Reference number
Abies balsamea
1
7
Abies balsamea
1
11
Abies balsamea
2
14
Abies balsamea
2
12
Abies balsamea
3
7
Abies balsamea
3
11
Abies balsamea
3
15

<tbody>
</tbody>

Well, hope that this thread triggers some interest. As I said, I know multiple steps to sort of get there, but in the end it is a lot of manual labor.
Thank you in advance for taking the time to read this thread and perhaps respond.
Best,
Maggie
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Try this:-
Results sheet2.
Code:
[COLOR=Navy]Sub[/COLOR] MG03Sep34
[COLOR=Navy]Dim[/COLOR] Nams()              [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Dic                 [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Rng                 [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn                  [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n                   [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Sp                  [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Ac                  [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Txt                 [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] s                   [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] s2                  [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] nn                  [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Sp2                 [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Num                 [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] c                   [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    [COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare


Nams = Array("14", "Burns", "1982", "6", "Clark", "1998", "9", "Cogbill", "1990", _
"1", "DeWolf", "2012", "8", "Dibble", "1994", "3", "Dibble", "2007", "10", "Dibble", _
"1990", "17", "Fernald", "1901", "18", "Hansen", "1938", "13", "Hansen", "1983", _
"11", "Hudson", "1985", "7", "Lortie", "1996", "15", "May", "1978", "12", "Rooney", _
"1984", "5", "Small", "2004", "16", "Stebbins", "1927", "4", "Weber", "2005", "2", _
"Weihrauch", "2010")


[COLOR=Navy]For[/COLOR] n = 1 To UBound(Nams) [COLOR=Navy]Step[/COLOR] 3: Dic(Nams(n)) = n: [COLOR=Navy]Next[/COLOR]


ReDim Ray(1 To Rng.Count * 50, 1 To 3)
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]For[/COLOR] Ac = 1 To 13
        Txt = Dn.Offset(, Ac)
        Sp = Split(Replace(Txt, "(", ")"), ")")
        [COLOR=Navy]For[/COLOR] s = 0 To UBound(Sp)
            Sp2 = Split(Sp(s), " ")
            [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] s2 [COLOR=Navy]In[/COLOR] Sp2
                [COLOR=Navy]If[/COLOR] Dic.exists(s2) [COLOR=Navy]Then[/COLOR]
                    [COLOR=Navy]If[/COLOR] InStr(Sp(s), Nams(Dic.Item(s2) + 1)) > 0 [COLOR=Navy]Then[/COLOR]
                    c = c + 1
                    Ray(c, 1) = Dn.Value
                    Ray(c, 2) = Ac '[COLOR=Green][B]Range("A1").Offset(, Ac).Value[/B][/COLOR]
                    Ray(c, 3) = Nams(Dic.Item(s2) - 1)
                    [COLOR=Navy]End[/COLOR] If
                [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]Next[/COLOR] s2
        [COLOR=Navy]Next[/COLOR] s
[COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]With[/COLOR] Sheets("Sheet2")
    .Range("A1").Resize(, 3).Value = Array("Species", "Township", "Reference number ")
    .Range("A2").Resize(c, 3) = Ray
[COLOR=Navy]End[/COLOR] [COLOR=Navy]With[/COLOR]
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
YIPEEEE...YAHOOOO....WOW! That is AWESOME! I am so tickled pink I could cry! Thank you so very much for this! Upon preliminary proofing it looks PERFECT.
Just can't thank you enough.
Best Wishes with big smiles,
Maggie
 
Upvote 0
HELLO MICK G, HELP?
Upon further investigation, I am finding an error. I have no data for References 3, 8, and 10. I deleted reference # 18 from the macro because it was an error in the reference table as it turned out. I looked at the macro and discovered that, I believe the issues are arising from the Reference name Dibble, because there are three years which are references 8,3, and 10. This is the only reference now with the same author and different years. As I mentioned in my first post I was worried this might cause a problem. Do you know how this could be modified so it will search and find these references? Can we request the search for each reference within a set of ()? That might help delineate the author year to a more distinct variable for searching perhaps.

Nams = Array("14", "Burns", "1982", "6", "Clark", "1998", "9", "Cogbill", "1990", _
"1", "DeWolf", "2012", "8", "Dibble", "1994", "3", "Dibble", "2007", "10", "Dibble", _
"1990",
"17", "Fernald", "1901", "13", "Hansen", "1983", _
"11", "Hudson", "1985", "7", "Lortie", "1996", "15", "May", "1978", "12", "Rooney", _
"1984", "5", "Small", "2004", "16", "Stebbins", "1927", "4", "Weber", "2005", "2", _
"Weihrauch", "2010")

Thank you for your help.
Best,
Maggie
 
Upvote 0
Thank you for your appreciation !!
Try this:-
The code should now find all instances of the Names such as "Dibble".
Code:
[COLOR="Navy"]Sub[/COLOR] MG04Sep06
'[COLOR="Green"][B]Mg2[/B][/COLOR]
[COLOR="Navy"]Dim[/COLOR] Nams()              [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Dic                 [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Rng                 [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn                  [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n                   [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Sp                  [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Ac                  [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Txt                 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] s                   [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] s2                  [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] nn                  [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Sp2                 [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Num                 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c                   [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dup [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare


Nams = Array("14", "Burns", "1982", "6", "Clark", "1998", "9", "Cogbill", "1990", _
"1", "DeWolf", "2012", "8", "Dibble", "1994", "3", "Dibble", "2007", "10", "Dibble", _
"1990", "17", "Fernald", "1901", "18", "Hansen", "1938", "13", "Hansen", "1983", _
"11", "Hudson", "1985", "7", "Lortie", "1996", "15", "May", "1978", "12", "Rooney", _
"1984", "5", "Small", "2004", "16", "Stebbins", "1927", "4", "Weber", "2005", "2", _
"Weihrauch", "2010")


[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Nams) [COLOR="Navy"]Step[/COLOR] 3
    [COLOR="Navy"]If[/COLOR] Not Dic.exists(Nams(n)) [COLOR="Navy"]Then[/COLOR]
        Dic.Add (Nams(n)), n
    [COLOR="Navy"]Else[/COLOR]
        Dic.Item(Nams(n)) = Dic.Item(Nams(n)) & "," & n
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]


ReDim Ray(1 To Rng.Count * 50, 1 To 13)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]For[/COLOR] Ac = 1 To 13
        Txt = Dn.Offset(, Ac)
        Sp = Split(Replace(Txt, "(", ")"), ")")
        [COLOR="Navy"]For[/COLOR] s = 0 To UBound(Sp)
            Sp2 = Split(Sp(s), " ")
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] s2 [COLOR="Navy"]In[/COLOR] Sp2
                [COLOR="Navy"]If[/COLOR] Dic.exists(s2) [COLOR="Navy"]Then[/COLOR]
                   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dup [COLOR="Navy"]In[/COLOR] Split(Dic.Item(s2), ",")
                    [COLOR="Navy"]If[/COLOR] InStr(Sp(s), Nams(Dup + 1)) > 0 [COLOR="Navy"]Then[/COLOR]
                        c = c + 1
                        Ray(c, 1) = Dn.Value
                        Ray(c, 2) = Ac
                        Ray(c, 3) = Nams(Dup - 1)
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] Dup
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] s2
        [COLOR="Navy"]Next[/COLOR] s
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn


[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    .Range("A1").Resize(, 3).Value = Array("Species", "Township", "Reference number ")
    .Range("A2").Resize(c, 3) = Ray
[COLOR="Navy"]End[/COLOR] With
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Hey Mick,
Thank you very much with seeing this through. I now have all the townships listed that should be and the only odd entries I am finding are associated with oddities in my DB file. Reading macros is like trying to learn a language for sure, one that I find very interesting and hope to not be so illiterate in someday. I had put the two macros next to each other and looked them over line for line to see what it was that you changed to make it work. I noticed new text in Step 3, and green text beside Ray(c, 2) =, of course what those mean are still totally foreign to me. I know it is a lot to ask, but if at some point if you wouldn't mind, and you had the time, if you could explain some of the details of the macro I would appreciate it.
Thank you again for everything.
Best wishes,
Maggie
 
Upvote 0
Thank you for your interest.
Below is the code with comments
Some light bedtime reading !!!!!!
I hope it is useful to you !!
Code:
[COLOR=Navy]Sub[/COLOR] MG04Sep23
[COLOR=Navy]Dim[/COLOR] Nams()              [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Dic                 [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Rng                 [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn                  [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n                   [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Sp                  [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Ac                  [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Txt                 [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] s                   [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] s2                  [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] nn                  [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] Sp2                 [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Num                 [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer[/COLOR]
[COLOR=Navy]Dim[/COLOR] c                   [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Dup [COLOR=Navy]As[/COLOR] Variant
'[COLOR=Green][B]##########[/B][/COLOR]
'[COLOR=Green][B]This line set all the data in column "A" to a range variable "Rng"[/B][/COLOR]
'[COLOR=Green][B]This enables the code to loop through each value in that range:- "Rng"[/B][/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
 
 '[COLOR=Green][B]###########[/B][/COLOR]
 '[COLOR=Green][B]This line creates an instance of a scripting.Dictionary to store Array "Nams" and positions of "Names" with the array "Nams"[/B][/COLOR]
 [COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
'[COLOR=Green][B]###########[/B][/COLOR]
'[COLOR=Green][B]This array is obviously your Names/Years and related numbers[/B][/COLOR]
Nams = Array("14", "Burns", "1982", "6", "Clark", "1998", "9", "Cogbill", "1990", _
"1", "DeWolf", "2012", "8", "Dibble", "1994", "3", "Dibble", "2007", "10", "Dibble", _
"1990", "17", "Fernald", "1901", "18", "Hansen", "1938", "13", "Hansen", "1983", _
"11", "Hudson", "1985", "7", "Lortie", "1996", "15", "May", "1978", "12", "Rooney", _
"1984", "5", "Small", "2004", "16", "Stebbins", "1927", "4", "Weber", "2005", "2", _
"Weihrauch", "2010")


'[COLOR=Green][B]##############[/B][/COLOR]
'[COLOR=Green][B]These lines below loops through  the "Nams" array to load Names to the "Dictionary", but only in steps of 3.[/B][/COLOR]
'[COLOR=Green][B]This means that only the actual names like "Dibble or "Burns" are Loaded.[/B][/COLOR]
'[COLOR=Green][B]The purpose of this loop is to enter all those names in the dictionary with their related position "n".[/B][/COLOR]
'[COLOR=Green][B]The dictionary is a list (collection) of the Names (keys)and against each name is ite[/B][/COLOR]
'[COLOR=Green][B]its position (item) "n" in the list[/B][/COLOR]




[COLOR=Navy]For[/COLOR] n = 1 To UBound(Nams) [COLOR=Navy]Step[/COLOR] 3
    [COLOR=Navy]If[/COLOR] Not Dic.Exists(Nams(n)) [COLOR=Navy]Then[/COLOR]
       '[COLOR=Green][B]Name (Key) added ------- Postion (item,)added[/B][/COLOR]
        Dic.Add (Nams(n)), n
    [COLOR=Navy]Else[/COLOR]
       '[COLOR=Green][B]If that any name repeats itself , then the new "Name" positions are added to (Item) "n" as a string[/B][/COLOR]
        Dic.Item(Nams(n)) = Dic.Item(Nams(n)) & "," & n
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
'[COLOR=Green][B]The array "Ray" is given rows and columns to hold the Final results[/B][/COLOR]
ReDim Ray(1 To Rng.Count * 50, 1 To 13)


'[COLOR=Green][B]The object now is to Loop down column "A" and across each of 13 columns,searching for those "Names"[/B][/COLOR]


'[COLOR=Green][B]Loop down column "A2[/B][/COLOR]
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
'[COLOR=Green][B]loop across 13 column in that row.[/B][/COLOR]
    [COLOR=Navy]For[/COLOR] Ac = 1 To 13
'[COLOR=Green][B]In each cell that is met, the following is done[/B][/COLOR]
'[COLOR=Green][B]Hold the cell data in  string names "Txt"[/B][/COLOR]
        Txt = Dn.Offset(, Ac)
'[COLOR=Green][B]Change all the right brackets to left hand Brackets, This way the Brackest are all the same.[/B][/COLOR]
'[COLOR=Green][B]Use the "Split" function, to split the data (into an array "Sp" by the Right hand Brackest[/B][/COLOR]
        Sp = Split(Replace(Txt, "(", ")"), ")")
'[COLOR=Green][B] This way each set of data within a Bracket set is held as a seperate set of data.[/B][/COLOR]
        
'[COLOR=Green][B]Loop through each value in the array "SP"[/B][/COLOR]
        [COLOR=Navy]For[/COLOR] s = 0 To UBound(Sp)
            
'[COLOR=Green][B]Split each value within each bracket by the "Space" into an array "Sp2"[/B][/COLOR]
            Sp2 = Split(Sp(s), " ")
'[COLOR=Green][B]Loop through each value in array("Sp2"[/B][/COLOR]
            [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] s2 [COLOR=Navy]In[/COLOR] Sp2
'[COLOR=Green][B]Now here's the clever bit !!![/B][/COLOR]
'[COLOR=Green][B]If the "Name that we Find is in the "Dictionary" collection we can find it by using the "Exists" function[/B][/COLOR]
'[COLOR=Green][B]The line below asks:- does the name we have found in this range loop "Exist" in the Dictionary[/B][/COLOR]
                
                [COLOR=Navy]If[/COLOR] Dic.Exists(s2) [COLOR=Navy]Then[/COLOR]
'[COLOR=Green][B] If the name "Exist" then the code continues down the loop[/B][/COLOR]
'[COLOR=Green][B]So we have found the name in the "Dictionary" now we need to find if the right "Year" is with it and what its reference number is.[/B][/COLOR]


'[COLOR=Green][B]############[/B][/COLOR]
'[COLOR=Green][B]When we loaded the names in the dictionary we also loaded all the related duplicate Postions "n"-> remember !!!![/B][/COLOR]
'[COLOR=Green][B]So we now split that string for that particular "Name" and see what numbers we find.[/B][/COLOR]
 '[COLOR=Green][B]Then loop through all the numnbers[/B][/COLOR]
                   [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dup [COLOR=Navy]In[/COLOR] Split(Dic.Item(s2), ",")
 '[COLOR=Green][B]Dup is the variable for any one of the numbers associated with any particular "Name"[/B][/COLOR]
 
 '[COLOR=Green][B]###############[/B][/COLOR]
 '[COLOR=Green][B]Now Sp(s) from above, represents all the data within any one Bracket within any one Cell.[/B][/COLOR]
 '[COLOR=Green][B]As we have found the "Name" we want to know if the "Year" is also there.??[/B][/COLOR]
 
 '[COLOR=Green][B]########[/B][/COLOR]
 '[COLOR=Green][B]Now dup represents the postion number of the name within the array "nams", and we know that[/B][/COLOR]
 '[COLOR=Green][B]one postion to the right in the array "Nams" is the "Year" Relating to the "Name"[/B][/COLOR]
 '[COLOR=Green][B]So as seen below, Nams(Dup + 1)is the "Year" next to the Name in Array "Nams"[/B][/COLOR]
 '[COLOR=Green][B]Using the "Instr" Function we can test to see if that Year is within the "Bracket data"[/B][/COLOR]
                    
 '[COLOR=Green][B]#############[/B][/COLOR]
                    [COLOR=Navy]If[/COLOR] InStr(Sp(s), Nams(Dup + 1)) > 0 [COLOR=Navy]Then[/COLOR]
 '[COLOR=Green][B]If the value from "Instr" is greater that 0 then it exists.[/B][/COLOR]
 '[COLOR=Green][B]We can now proceed to add that data to our array "Ray"[/B][/COLOR]
                        c = c + 1 '[COLOR=Green][B] Array counter[/B][/COLOR]
                        Ray(c, 1) = Dn.Value '[COLOR=Green][B] This is the Name[/B][/COLOR]
                        Ray(c, 2) = Ac  '[COLOR=Green][B]This is the column Position[/B][/COLOR]
                        Ray(c, 3) = Nams(Dup - 1) '[COLOR=Green][B] This is Reference Number, One to the left from The "Name" within array "Nams"[/B][/COLOR]
                    [COLOR=Navy]End[/COLOR] If
                [COLOR=Navy]Next[/COLOR] Dup
                [COLOR=Navy]End[/COLOR] If
            [COLOR=Navy]Next[/COLOR] s2
        [COLOR=Navy]Next[/COLOR] s
[COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]Next[/COLOR] Dn


[COLOR=Navy]With[/COLOR] Sheets("Sheet2")
    '[COLOR=Green][B]load Headers to sheet2[/B][/COLOR]
    .Range("A1").Resize(, 3).Value = Array("Species", "Township", "Reference number ")
    '[COLOR=Green][B]Load values to sheet2 from array "Ray"[/B][/COLOR]
    .Range("A2").Resize(c, 3) = Ray
[COLOR=Navy]End[/COLOR] With
MsgBox "Run"
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
Mick,
WOW! Super cool! It will take me awhile to attempt to digest some of this, but I can always use a little "light reading"...LOL.
Thanks a bunch!
Best,
Maggie
 
Upvote 0

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

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