How do I search within a searched range?

Question

I have the following data, and i want to map it into an excel sheet with a particular format. I need to extract the node name ie. "BLRTRC1" , "BSC23" , "BSC41" (there can be multiple occurrences of a single node with different alarm conditions).

First I have to search for "BLRTRC1" , now I want to search all the alarm names that can be there like "SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION", "DIGITAL PATH QUALITY SUPERVISION" etc within its range ie. up until the next node name does not show up (like in this case "BSC23" shows up after 3 occurrences of "BLRTRC1" )

Then print the node name with the alarm name and the alarm statistics like

"SDIP     STATE     LAYER    K   L  M  FAULT  INFO    DATE    TIME
 8ETM2    TRAFLIM   VC15-2   32  1  1  UNEQ           130226  030244"  

Similarly I have to do this for all the nodes. I have been stuck on this for over a week now, just cannot seem to get it, please help.

Here is the sample text I want to edit.

PS. I have already imported this text into the excel sheet in "A:A"

A1/APT "BLRTRC1\02\G12" 007 130226   0302      
SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION

SDIP     STATE     LAYER    K  L  M  FAULT  INFO    DATE    TIME
8ETM2    TRAFLIM   VC15-2   32  1  1  UNEQ           130226  030244

TYPE  PL/TTI                                   ERDIINFO


A1/APT "BLRTRC1\02\G12" 007 130226   0302      
SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION

SDIP     STATE     LAYER    K  L  M  FAULT  INFO    DATE    TIME
7ETM2    TRAFLIM   VC12-2   3  1  1  UNEQ           130226  030244

TYPE  PL/TTI                                   ERDIINFO


A3/APT "BLRTRC1\02\G12" 009 130226   0302      
DIGITAL PATH QUALITY SUPERVISION

SDIP     STATE     LAYER    K  L  M  FAULT  INFO    DATE    TIME
7ETM2    TRAFLIM   VC12-8   3  3  1  UNEQ           130226  030244

TYPE  PL/TTI                                   ERDIINFO


A3/APT "BBSC23/G12A/CPA" 021 130521   1130      
DIGITAL PATH QUALITY SUPERVISION

SES
DIP      DIPPART  SESL2  QSV    SECTION  DATE    TIME
42MNPBS           1      1               130521  113000

TYPE  PL/TTI                                   ERDIINFO

A2/APT "BSC41\\CPA02\\G" 985 130521   1204      
DIGITAL PATH FAULT SUPERVISION

DIP      DIPEND   FAULT     SECTION   HG  DATE    TIME
BL2397            RDI                     130521  120407

and this is the type of output i require with the use of a macro

nodename        Alarm name                                  alarmlevel
BLRTRC1 SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION  SDIP     STATE     LAYER    K  L  M  FAULT  INFO    DATE    TIME
                                                    8ETM2    TRAFLIM   VC15-2   32  1  1  UNEQ           130226  030244
BLRTRC1 SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION  SDIP     STATE     LAYER    K  L  M  FAULT  INFO    DATE    TIME
                                                    7ETM2    TRAFLIM   VC12-2   3  1  1  UNEQ           130226  030244
BLRTRC1 DIGITAL PATH QUALITY SUPERVISION            SDIP     STATE     LAYER    K  L  M  FAULT  INFO    DATE    TIME
                                                    7ETM2    TRAFLIM   VC12-8   3  3  1  UNEQ           130226  030244
BSC23   DIGITAL PATH QUALITY SUPERVISION            DIP      DIPPART  SESL2  QSV    SECTION  DATE    TIME
                                                    42MNPBS           1      1               130521  113000
BSC41   DIGITAL PATH FAULT SUPERVISION                  DIP      DIPEND   FAULT     SECTION   HG  DATE    TIME
                                                    BL2397            RDI                     130521  120407

here is the code i have worked on till now

Sub Search11()
Dim TEST
Dim Today
Today = Now

Dim c(4) As Variant
Dim a(4) As Variant
a(0) = 1
For i = 0 To 3
Set Test20 = Range(Cells(a(i), 1), Cells(a(i) + 32, 1)).Find(What:="BLRTRC1")

If Test20 Is Nothing Then
GoTo LABEL1
Else
a(i + 1) = Test20.Row
c(i) = "BLRTRC1"
End If
LABEL1:    Next i

Dim d(4) As Variant
Dim b(4) As Variant
b(0) = 1
For i = 0 To 3
Set Test21 = Range(Cells(b(i), 1), Cells(b(i) + 32, 1)).Find(What:="BSC23")

If Test21 Is Nothing Then
GoTo LABEL2
Else
b(i + 1) = Test21.Row
d(i) = "BSC23"
End If
LABEL2:    Next i

Dim e(4) As Variant
Dim f(4) As Variant
e(0) = 1
For i = 0 To 3
Set Test21 = Range(Cells(e(i), 1), Cells(e(i) + 32, 1)).Find(What:="BSC41")

If Test21 Is Nothing Then
GoTo LABEL3
Else
e(i + 1) = Test21.Row
f(i) = "BSC41"
End If
LABEL3:    Next i


Dim o(3) As Variant
o(0) = "SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION"
o(1) = "DIGITAL PATH QUALITY SUPERVISION"
o(2) = "DIGITAL PATH FAULT SUPERVISION"

Dim t(2) As Variant
t(0) = "SYNCHRONOUS DIGITAL PATH FAULT SUPERVISION/A1"
t(1) = "DIGITAL PATH QUALITY SUPERVISION/A3"
t(2) = "DIGITAL PATH FAULT SUPERVISION/A2"

Dim s(3) As Variant

s(0) = "SDIP"
s(1) = "DIP"
s(2) = "DIP"

R = 2
i = 0


For i = 0 To 3
k = 0
If a(i) > 0 Then

For k = 0 To 2
Set Test4 = Range(Cells(a(i), 1), Cells(a(i) + 10, 1)).Find(What:=o(k))

If Test4 Is Nothing Then
    GoTo NXTALARM
Else
    Set Test5 = Range(Cells(a(i), 1), Cells(a(i) + 10, 1)).Find(What:=s(k))
    If Test5 Is Nothing Then
    GoTo NXTALARM
    Else
    p = Test5.Row
    Cells(p + 1, 1).Select
    Selection.Copy
    Sheets("Sheet2").Activate
    Range("C" & R + 1).Select
    ActiveSheet.Paste
    Cells(R, 1).Value = c(i)
    Cells(R, 2).Value = t(k)
    Cells(R, 3).Value = Test5
    Cells(R, 4).Value = Today
    Sheets("Sheet4").Activate
    R = R + 2
End If
End If
NXTALARM: Next k

Else
End If

If b(i) > 0 Then

For k = 0 To 2
Set Test4 = Range(Cells(b(i), 1), Cells(b(i) + 10, 1)).Find(What:=o(k))

If Test4 Is Nothing Then
    GoTo NXTALARM2
Else
    Set Test5 = Range(Cells(b(i), 1), Cells(b(i) + 10, 1)).Find(What:=s(k))
    If Test5 Is Nothing Then
    GoTo NXTALARM2
    Else
    p = Test5.Row
    Cells(p + 1, 1).Select
    Selection.Copy
    Sheets("Sheet2").Activate
    Range("C" & R + 1).Select
    ActiveSheet.Paste
    Cells(R, 1).Value = d(i)
    Cells(R, 2).Value = t(k)
    Cells(R, 3).Value = Test5
    Cells(R, 4).Value = Today
    Sheets("Sheet4").Activate
    R = R + 2
End If
End If
NXTALARM2: Next k

Else
End If 
If e(i) > 0 Then

For k = 0 To 2
Set Test4 = Range(Cells(e(i), 1), Cells(e(i) + 10, 1)).Find(What:=o(k))

If Test4 Is Nothing Then
    GoTo NXTALARM2
Else
    Set Test5 = Range(Cells(e(i), 1), Cells(e(i) + 10, 1)).Find(What:=s(k))
    If Test5 Is Nothing Then
    GoTo NXTALARM3
    Else
    p = Test5.Row
    Cells(p + 1, 1).Select
    Selection.Copy
    Sheets("Sheet2").Activate
    Range("C" & R + 1).Select
    ActiveSheet.Paste
    Cells(R, 1).Value = f(i)
    Cells(R, 2).Value = t(k)
    Cells(R, 3).Value = Test5
    Cells(R, 4).Value = Today
    Sheets("Sheet4").Activate
    R = R + 2
End If
End If
NXTALARM3: Next k

Else
End If


'NXTALARM: Next k
NXTNODE: Next i

'Application.Run ("multiplebuttons")
'Application.Run ("CommentAddOrEdit")
   ' MsgBox a(55)
End Sub

This code of mine is causing 100s of duplicates to occur, and if i try to extend the ranges it stucks!!

http://postimg.org/gallery/oqk3ga8/

Answer 1

You will make life a lot simpler if you change your output to be single line table entries rather than double line "paragraphs". [You can reformat at a later stage if necessary.] As a 1st step, I would develop a "parser" to reformat your input - onto an adjacent worksheet - into single line entries.