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]

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

They should be appended.

 

[kpark91]

-_-;; I'll just email you.

 

[fari1]

y dun u email me then

 

[fari1]

okay, thanks, i'll check and ll let u know

 

[fari1]

y've combined these two codes, i want separate CIK and this one, as i'll use cik in one sheet and this code in another, will u plz separate these codes for me, i'll check by email

 

[wigi]

y've combined these two codes, i want separate CIK and this one, as i'll use cik in one sheet and this code in another, will u plz separate these codes for me, i'll check by email

I thought this is a public forum?

Why not posting the code over here?

 

[fari1]

because codes contain html tags and they just garbled over here, he has just posted it, u chk it for yourself

 

[kpark91]

I hate my email account. it's so slow and I'm lazy as well.

here you go.

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 "*""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

 

[kpark91]

Just quote my reply and you got a complete code... I hate how it just garbles over here lol.

 

[fari1]

some part of your code is up there as well, is it also the part of the code, right?