Find item in a list relevant to a given label

E

EDUCATED MONKEY

Board Regular
Joined
Jul 17, 2011
Messages
218
set up office 2007 win xp pro ie 8
The is my second attempt at solving this problem, the previous attempt fail as it seemed to retain the variables after the process had run for a few cycles<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
The help with that version was kindly given by member Jythier <o:p></o:p>
Which credit due worked fine just my lack of knowledge prevent me from knowing how to clear the variables, this was clearly the problem as It was possible to get the previous results even with the sample data cleared from column A<o:p></o:p>
The post was entitled Discriminate between two strings<o:p></o:p>
The current idea is to have the items in an array and check each against the contents in column A row by row till a match is found of loop ended no possible match<o:p></o:p>
Reasonable results being achieved but for some reason some items fail to match which is were I could do with some help as I have looked at this for some considerable time and not been able to spot the problem <o:p></o:p>
So if you can help with this or version one that would be great<o:p></o:p>
<o:p> </o:p>
<TABLE style="MARGIN: auto auto auto 4.65pt; WIDTH: 361pt; BORDER-COLLAPSE: collapse; mso-yfti-tbllook: 1184; mso-padding-alt: 0cm 5.4pt 0cm 5.4pt" class=MsoNormalTable border=0 cellSpacing=0 cellPadding=0 width=481><TBODY><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap> Data IN Column A <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 1"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap>ISBN13 9780340693124<o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 2"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap>(What's this?) Volumes 1 <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 3"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap>Publisher Hodder & Stoughton General Division Weight (grammes) 940 <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 4"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap>Imprint Hodder & Stoughton Ltd Reprint date 28-Feb-2010 12:00:00 am <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 5"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap>Format Hardback Published in London <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 6"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap>Publication date 06 Nov 1997 Height (mm) 259 <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 7"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap>Non-book description 208 Width (mm) 204 <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 8"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap>Illustrator Harriet Logan, Henry Bourne Spine width (mm) 20 <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 9"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap>DEWEY 641.5 Academic level General <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 10; mso-yfti-lastrow: yes"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 361pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=481 noWrap>DEWEY edition DC21 <o:p></o:p>
</TD></TR></TBODY></TABLE>

Results in column D<o:p></o:p>
<TABLE style="MARGIN: auto auto auto -1.7pt; WIDTH: 114.55pt; BORDER-COLLAPSE: collapse; mso-yfti-tbllook: 1184; mso-padding-alt: 0cm 5.4pt 0cm 5.4pt" class=MsoNormalTable border=0 cellSpacing=0 cellPadding=0 width=153><TBODY><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 0; mso-yfti-firstrow: yes"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 114.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=153 noWrap>
208<o:p></o:p>​
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 1"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 114.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=153 noWrap>
9780340693124<o:p></o:p>​
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 2"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 114.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=153 noWrap> 28-Feb-2010 12:00:00 am <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 3"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 114.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=153 noWrap> (mm) 204 <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 4"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 114.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=153 noWrap> (mm) 20 <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 5"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 114.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=153 noWrap> General <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 6"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 114.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=153 noWrap>edition DC21 <o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 7"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 114.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=153 noWrap>Not specified<o:p></o:p>
</TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 8"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 114.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=153 noWrap></TD></TR><TR style="HEIGHT: 12.75pt; mso-yfti-irow: 9; mso-yfti-lastrow: yes"><TD style="BORDER-BOTTOM: #ece9d8; BORDER-LEFT: #ece9d8; PADDING-BOTTOM: 0cm; BACKGROUND-COLOR: transparent; PADDING-LEFT: 5.4pt; WIDTH: 114.55pt; PADDING-RIGHT: 5.4pt; HEIGHT: 12.75pt; BORDER-TOP: #ece9d8; BORDER-RIGHT: #ece9d8; PADDING-TOP: 0cm" vAlign=bottom width=153 noWrap></TD></TR></TBODY></TABLE>
Please note that the format of the sample data can change eg date and pages may be on the same row and any combination there in. the other minor problem is the I only want the 2010 part of the date result which adds a further complication<o:p></o:p>
<o:p>
Rich (BB code): 
Option Explicit
Option Base 1
Sub FindString()</o:p>
Rich (BB code):
Rich (BB code): 
<o:p>Dim row, ItemCount As Integer
Dim LPosition As Integer</o:p>
<o:p>Dim ItemList, MyItem, MyString, BookItem, position As Variant</o:p>
<o:p>
ItemList = Array("Pages", "ISBN13", "date", "DEWEY edition", "DEWEY ", "Height (mm) ", "Width", "Spine width", "Weight (grammes) ", "Academic level", "Format")
row = 1
ItemCount = 1
start2:
Do While ItemCount < 12
MyItem = ItemList(ItemCount)
MyString = Worksheets("DeweyNumber").Cells(row, 1).Value ' column A
If InStr(MyString, MyItem) = 0 Then
MsgBox (MyItem)
row = row + 1
If row < 15 Then
GoTo start2
Else
Worksheets("DeweyNumber").Cells(row, 4).Value = "Not specified"
row = 1
ItemCount = ItemCount + 1
GoTo start2
End If

Else
LPosition = InStr(MyString, MyItem)

BookItem = Mid(MyString, LPosition + Len(MyItem), Len(MyString) + Len(MyItem) - LPosition)
Worksheets("DeweyNumber").Cells(row, 4).Value = BookItem
ItemCount = ItemCount + 1
End If
Loop
End Sub
</o:p>
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
I have provided some alternate code that may assist you in working out what you need. Given the non-rigid input you may have problems extracting all of the data you desire.

Code: 
Sub Parse()
    Dim row, ItemCount As Integer
    Dim LPosition As Integer
    Dim ItemList, MyItem, MyString, BookItem, position As Variant
 
    Dim lFirstDataRow As Long
    Dim lLastDataRow As Long
    Dim lX As Long
    Dim sHeader As String
    Dim lActiveColumn As Long
 
 
    ItemList = Array("Pages", "ISBN13", "date", "DEWEY edition", "DEWEY ", "Height (mm) ", "Width", "Spine width", "Weight (grammes) ", "Academic level", "Format")
 
    With Worksheets("DeweyNumber")
 
        If Len(.Cells(1, 1).Value) > 0 Then
            lFirstDataRow = 1
        Else
            lFirstDataRow = .Cells(1, 1).End(xlDown).row
        End If
 
        lLastDataRow = .Cells(.Rows.Count, 1).End(xlUp).row
 
        For row = lFirstDataRow To lLastDataRow
 
            Do While Len(Cells(row, 1).Value) > 0
                lActiveColumn = 3
                MyString = Worksheets("DeweyNumber").Cells(row, 1).Value ' column A
                For lX = LBound(ItemList) To UBound(ItemList)
                    MyItem = ItemList(lX)
                    LPosition = InStr(MyString, MyItem)
 
                    If LPosition > 0 Then
                        Worksheets("DeweyNumber").Cells(row, lActiveColumn).Value = MyItem
                        BookItem = Mid(MyString, LPosition + Len(MyItem), Len(MyString) + Len(MyItem) - LPosition)
                        If MyItem = "ISBN13" Then
                            sHeader = "'"
                        Else
                            sHeader = ""
                        End If
                        If MyItem = "date" Then
                            If IsDate(BookItem) Then BookItem = "'" & Left(Format(BookItem, "dd-mmm"), 6)
                        End If
                        Worksheets("DeweyNumber").Cells(row, lActiveColumn + 1).Value = _
                            sHeader & BookItem
 
                        lActiveColumn = lActiveColumn + 2
                    End If
 
                Next
            row = row + 1
            Loop
        Next
    End With
End Sub

A few more examples of inputs and desired outputs should allow refinement of the code.

Perhaps this post on Fuzzy matching may provide some useful insight:
http://www.mrexcel.com/forum/showthread.php?t=195635
 
Upvote 0
pbornemeier said:
I have provided some alternate code that may assist you in working out what you need. Given the non-rigid input you may have problems extracting all of the data you desire.

Code: 
Sub Parse()
    Dim row, ItemCount As Integer
    Dim LPosition As Integer
    Dim ItemList, MyItem, MyString, BookItem, position As Variant
 
    Dim lFirstDataRow As Long
    Dim lLastDataRow As Long
    Dim lX As Long
    Dim sHeader As String
    Dim lActiveColumn As Long
 
 
    ItemList = Array("Pages", "ISBN13", "date", "DEWEY edition", "DEWEY ", "Height (mm) ", "Width", "Spine width", "Weight (grammes) ", "Academic level", "Format")
 
    With Worksheets("DeweyNumber")
 
        If Len(.Cells(1, 1).Value) > 0 Then
            lFirstDataRow = 1
        Else
            lFirstDataRow = .Cells(1, 1).End(xlDown).row
        End If
 
        lLastDataRow = .Cells(.Rows.Count, 1).End(xlUp).row
 
        For row = lFirstDataRow To lLastDataRow
 
            Do While Len(Cells(row, 1).Value) > 0
                lActiveColumn = 3
                MyString = Worksheets("DeweyNumber").Cells(row, 1).Value ' column A
                For lX = LBound(ItemList) To UBound(ItemList)
                    MyItem = ItemList(lX)
                    LPosition = InStr(MyString, MyItem)
 
                    If LPosition > 0 Then
                        Worksheets("DeweyNumber").Cells(row, lActiveColumn).Value = MyItem
                        BookItem = Mid(MyString, LPosition + Len(MyItem), Len(MyString) + Len(MyItem) - LPosition)
                        If MyItem = "ISBN13" Then
                            sHeader = "'"
                        Else
                            sHeader = ""
                        End If
                        If MyItem = "date" Then
                            If IsDate(BookItem) Then BookItem = "'" & Left(Format(BookItem, "dd-mmm"), 6)
                        End If
                        Worksheets("DeweyNumber").Cells(row, lActiveColumn + 1).Value = _
                            sHeader & BookItem
 
                        lActiveColumn = lActiveColumn + 2
                    End If
 
                Next
            row = row + 1
            Loop
        Next
    End With
End Sub

A few more examples of inputs and desired outputs should allow refinement of the code.

Perhaps this post on Fuzzy matching may provide some useful insight:
http://www.mrexcel.com/forum/showthread.php?t=195635
Click to expand...
Thank you for taking the trouble to reply, I agree it is something of a nightmare<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
As the things change so often, also I have now found that data is also repeated often slightly different, it’s the human element!<o:p></o:p>
<o:p> </o:p>
At the moment I have opted to grab a chunk of it and past it into a column then having set up a look for and if error situation I can at least get rid of like items <o:p></o:p>
I shall see if implement your solution helps <o:p></o:p>
<o:p> </o:p>
Thanks Pete<o:p></o:p>
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
1K
Attrazion
A
E
  • Question
VBA for Web Scraping help
Replies
0
Views
609
epactheactor
E
G
  • Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
858
gvsumich
G
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
472
AndyEd
A

Forum statistics

Threads
1,215,695
Messages
6,126,261
Members
449,307
Latest member
Andile

Share this page

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