tomppa
tomppa

Reputation: 3

Copy contents between strings conditional on cell value

I'm very new to VBA and have been tasked with writing a macro.

I have a system generated file that looks like this
starting file

I should end up with three worksheets that look like this

ending file 1
ending file 1

ending file 2
ending file 2

ending file 3
ending file 3

That is, I am trying to find a way to copy the rows between "item 1" and "item 2", "item 2" and "item 3" etc. in all cases where the cells in columns D, E or F are not empty.

By browsing the forums I could find something to get me started, but I am not sure how to proceed. Any help would be appreciated. Thanks.

Sub CopyRows()
    Dim r As Range, fr As String    'Item1
    Dim c As Range, fc As String    'Item2
    Dim StartR As Integer
    Dim EndR As Integer
    Dim NwRng As Range, Nwc As Range
    Dim nwSh As Worksheet
    
    fr = "Item 1"
    fc = "Item 2"

    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("D" & StartR & ":D" & EndR)
    Set nwSh = Sheets.Add

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

End Sub

Upvotes: 0

Views: 48

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

Actually you can do that without looping just using autofilter. All you need is:

  1. Use Autofilter

  2. Filter for Description not blank AND Set1 not blank and copy it.

  3. Filter for Description not blank AND Set2 not blank and copy it.

  4. Filter for Description not blank AND Set3 not blank and copy it.

  5. Done.

No searching, no looping, no mess. The only thing you need to do in the end is cleaning up the columns you don't like.

Upvotes: 2

Related Questions