Extracting a text string Problem

[fari1]

my below code is perfect of extracting my another text string, but when i modify it to extract my another text string, it is not giving me results, trying real hard but unable to find the problem.

the text string to find is

BIK=0000055135

out of this line

<td bgcolor="#E6E6E6" valign="top" align="left"><a href="/chi-kin/browse-gar?action=getcompany&BIK=0000055135&owner=include&count=100">KELLY SERVICES INC (0000055135) (Filer)</a></td>

Sub GetCIK()
  Sheets("wquery").Select
  Dim X As Long, LastRow As Long, OutputRow As Long, CellContent As String
  Const StartRow As Long = 1
  Const DataCol As String = "A"
  Const OutputSheet As String = "URLs"
  Const OutputCol As String = "B"
  LastRow = Sheets("wquery").Cells(Rows.Count, DataCol).End(xlUp).Row
  OutputRow = Worksheets(OutputSheet).Cells(Rows.Count, OutputCol).End(xlUp).Row
  For X = StartRow To LastRow
    If LCase(Sheets("wquery").Cells(X, DataCol).Value) Like "*getcompany&""CIK*&*" Then
      OutputRow = OutputRow + 1
      CellContent = Sheets("wquery").Cells(X, DataCol).Value
      Worksheets(OutputSheet).Cells(OutputRow, OutputCol).Value = Split(Mid(CellContent, InStr(1, CellContent, "getcompany&""CIK", vbTextCompare) + 15), """amp")(0)
    End If
  Next

 

[kpark91]

I've PMed you.

 

[fari1]

i've emailed u

 

[kpark91]

Try this then..

It worked in the workbook you've sent me.
Btw, your HTML code says "BIK=####" while in your workbook, it's "CIK"

Option Base 0
Sub GetCIK()
  Dim X As Long, LastRow As Long, OutputRow As Long, CellContent As String
  Const StartRow As Long = 1
  Const DataCol As String = "A"
  Const OutputSheet As String = "URLs"
  Const OutputCol As String = "B"
  LastRow = Sheets("wquery").Cells(Rows.Count, DataCol).End(xlUp).Row
  OutputRow = Worksheets(OutputSheet).Cells(Rows.Count, OutputCol).End(xlUp).Row
  For X = StartRow To LastRow
    If Sheets("wquery").Cells(X, DataCol).Value Like "*getcompany*CIK*" Then
      OutputRow = OutputRow + 1
      CellContent = Sheets("wquery").Cells(X, DataCol).Value
      Worksheets(OutputSheet).Cells(OutputRow, OutputCol).Value = Left$(Split(CellContent, ";")(1), 14)
    End If
Next
End Sub

 

[fari1]

yahoo mail is slow these dayas, let me knwo when u have replied

 

[fari1]

oh sorry, i didn't see the post,let me try, i knew it was CIK, on my side, i was doing CIK

 

[fari1]

yes it worked now, thanks alottt

 

[fari1]

can u plz extract one more string out of it

<td nowrap="nowrap">10-Q</td>

i want to extract the text string between "nowrap and td" i-e 10-Q or whatever text in between

 

[fari1]

if u could assisst me on it

 

[kpark91]

Is that the whole line of the code?

Try:

Option Base 0
Option Explicit
Sub GetCIK()
   Dim X As Long, LastRow1 As Long, OutputRow1 As Long, CellContent As String, LastRow&
   Dim pos1&, pos2&, OutputRow2&
 
   Const StartRow As Long = 1
   Const DataCol As String = "A"
   Const OutputSheet As String = "URLs"
   Const OutputCol1 As String = "B"
   Const OutputCol2 As String = "C"
 
   LastRow = Sheets("wquery").Cells(Rows.Count, DataCol).End(xlUp).Row
   OutputRow1 = Worksheets(OutputSheet).Cells(Rows.Count, OutputCol1).End(xlUp).Row
   OutputRow2 = Worksheets(OutputSheet).Cells(Rows.Count, OutputCol2).End(xlUp).Row
 
   For X = StartRow To LastRow
       If Sheets("wquery").Cells(X, DataCol).Value Like "*getcompany*CIK*" Then
         OutputRow1 = OutputRow1 + 1
         CellContent = Sheets("wquery").Cells(X, DataCol).Value
         Worksheets(OutputSheet).Cells(OutputRow1, OutputCol1).Value = Left$(Split(CellContent, ";")(1), 14)
       End If
 
       If Sheets("wquery").Cells(X, DataCol).Value Like "*""nowrap*</TD>" Then
           OutputRow2 = OutputRow2 + 1
           CellContent = Sheets("wquery").Cells(X, DataCol).Value
           pos1 = InStr(1, CellContent, """nowrap""")
           pos2 = InStr(1, CellContent, "</TD>")
           Worksheets(OutputSheet).Cells(OutputRow2, OutputCol2).Value = Mid(CellContent, pos1 + 9, pos2 - pos1 - 9)
       End If
   Next X
 
End Sub

 

[kpark91]

The code does not seem to be pasting itself correctly.

Hold on.