CODEWITHSUNDEEP
excelvba
Nant
Nant

Reputation: 569

Get content between two strings in VBA Excel

I am writing a macro and I have the following problem:

I have a standardized sheet -> please look at attachment enter image description here

As the data between ###START and ###END can vary I want to write a macro that always looks between the content of ###START and ###END and copies the complete row that have the word dividend in action type into a new sheet. I somehow can't find a solution as I am new into VBA

Can someone please help

Upvotes: 0

Views: 2164

Answers (3)

Excel Hero
Excel Hero

Reputation: 14764

This should do it. Place the following procedure in a standard code module:

Public Sub GetDividends()
    Dim i&, k&, s$, v, r As Range, ws As Worksheet
    Set r = [index(a:a,match("###start",a:a,),):index(a:a,match("###end",a:a,),)].Offset(, 6)
    k = r.Row - 1
    v = r
    For i = 1 To UBound(v)
        If LCase$(v(i, 1)) = "dividend" Then
            s = s & ", " & i + k & ":" & i + k
        End If
    Next
    s = Mid$(s, 3)
    If Len(s) Then
        Set ws = ActiveSheet
        With Sheets.Add(, ws)
            ws.Range(s).Copy .[a1]
        End With
    End If
End Sub

Note: this technique focuses on efficiency. It minimizes the number of times the boundary between VBA and Excel is pierced. On large data sets this best practice will make a huge difference in performance.

Upvotes: 4

Davesexcel
Davesexcel

Reputation: 6984

You can use find to get the row locations then set you range from there.

Sub Button1_Click()
    Dim r As Range, fr As String    '##START
    Dim c As Range, fc As String    '##END
    Dim StartR As Integer
    Dim EndR As Integer
    Dim NwRng As Range, Nwc As Range
    Dim nwSh As Worksheet
    fr = "##Start"
    fc = "##END"
    Set r = Range("A:A").Find(what:=fr, lookat:=xlWhole)
    Set c = Range("A:A").Find(what:=fc, lookat:=xlWhole)

    If Not r Is Nothing Then
        StartR = r.Row + 1
    Else: MsgBox fr & " not found"
        Exit Sub
    End If

    If Not c Is Nothing Then
        EndR = c.Row - 1
    Else: MsgBox fc & " not found"
        Exit Sub
    End If

    Set NwRng = Range("G" & StartR & ":G" & EndR)
    Set nwSh = Sheets.Add

    For Each Nwc In NwRng.Cells
        If Nwc = "dividend" Then Nwc.EntireRow.Copy nwSh.Cells(nwSh.Rows.Count, "A").End(xlUp).Offset(1)
    Next Nwc

End Sub

Upvotes: 4

Tom K.
Tom K.

Reputation: 1042

This works if your Column Action_Type is at ColumnID 7. But I think the Source code is easy enough to alter it for your needs.

Sub copyRows()

Dim i As Integer
Dim ws As Worksheet


'1 is just the worksheet-ID, you can choose another one via name
Set ws = ThisWorkbook.Worksheets(1)


i = 2
j = 1


Do While ws.Cells(i, 1) <> "###END"

'as stated above, 7 refers to the column ID
If ws.Cells(i, 7) = "Dividend" Then


'Worksheets(2), see above

ws.Rows(i).EntireRow.Copy _
        Destination:=Worksheets(2).Rows(j)

j = j + 1

End If

i = i + 1


Loop

End Sub

Upvotes: 1

Related Questions