Complicated Excel VBA Macro with Loop

[Samoski]

Hi all.

I require help with a reasonably complicated VBA macro loop for a dataset I've been provided. The dataset exists as one long column one thousands of different entries.

I've tried recording macros but I am at a loss at the best way to approach it. Any help would be greatly appreciated. In its simplest terms, I need to locate a term (ie. "THIS IS A TEST"), copy that cell into new worksheet, go 72 cells up and copy whatever is in that cell into the new worksheet as well.

Logic for the VBA macro Loop...

1. Scan through all worksheets for the words "THIS IS A TEST"
2. Copy that cell into a new worksheet (eg. A1)
3. Go 72 cells up
4. Copy that cell into the new worksheet (eg. B1)

It needs to loop through the above logic across all open worksheets, dumping the results into a new worksheet. Here is an example with 3 results..

--------------------------------------------
A...........................|B.............
--------------------------------------------
THIS IS A TEST X....|BLERG... <------the cell 72 up from "THIS IS A TEST X"
--------------------------------------------
THIS IS A TEST 2....|BLER2.... <------the cell 72 up from "THIS IS A TEST 2"
--------------------------------------------
THIS IS A TEST 1....|BLEfff...... <------the cell 72 up from "THIS IS A TEST 1"
--------------------------------------------


Once again, thanks for any help I recieve.

[antoka05]

You could use a formula to do it.
For example, if you have your data in sheet1, column 'A' and your key to look for in sheet2, range 'a2' in range 'b2' you could write the formula:
=INDEX(Sheet1!A:A,MATCH(A2,Sheet1!A:A,0)-72)

See attached file where I applied formula.

Regards,
Antonio

[Samoski]

You could use a formula to do it.
For example, if you have your data in sheet1, column 'A' and your key to look for in sheet2, range 'a2' in range 'b2' you could write the formula:
=INDEX(Sheet1!A:A,MATCH(A2,Sheet1!A:A,0)-72)

See attached file where I applied formula.

Regards,
Antonio

Hi Antonio,

This is almost exactly what I need. However, there will be multiple instances of the same word pattern on a sheet.

As an example, there might be:
4 x "THIS IS A TEXT 2"
3 x "THIS IS A TEXT X"
100 x "THIS IS A TEXT 1"

There will also be multiple sheets that I need searched through.

Thank you so much for your help thus far, if you can further elabroate to help with what I've written above I will be forever grateful

-- Samoski

[snb]

sub snb()
  with sheets(1).columns(1).find("This is a test",,xlvalues,xlpart)
    sheets(2).cells(rows.count,1).end(xlup).offset(1).resize(,2)=Array(.value,.offset(-72).value)
  end with
End sub

or

sub snb()
  with sheets(1).columns(1)
    .autofilter 1, "This is a test"
    for each cl in .offset(1).specialcells(12)
       sheets(2).cells(rows.count,1).end(xlup).offset(1).resize(,2)=Array(cl.value,cl.offset(-72).value)
    Next
    .autofilter
  end with
End sub

[Samoski]

I've uploaded an excel file with some "test" data. There are two worksheets with some junk data in them.

The output should be:

THIS IS A TEST 123 | Person Name: John11
THIS IS A TEST 123XX | Person Name: Frank11
HELLO THIS IS A TEST YO | Person Name: Testie
THIS IS A TEST 123XX | Person Name: Yohan
HELLO THIS IS A TEST YO | Person Name: Skeet

Willing to deposit a small "helpers" fee for the person that is able to help me out sufficiently. The formula/macro will need to find a search term / combination of words (which may have other info either side, don't know if you can include %wildcard% type links in excel) across ALL worksheets and output them as pairs of a match of the term and the cell 72 above it.

Thanks so much for the help thus far guys

[antoka05]

See attached file where I added this macro:

Sub Macro1()
   Dim meSh As Worksheet
   Dim sh As Variant, textToFind As String
   Dim found As Range, firstAddress As String
   Dim destRow As Long
   
   destRow = 1
   textToFind = "TEST "
   With ThisWorkbook
      Set meSh = .ActiveSheet
      meSh.Range("2:" & Rows.Count).ClearContents
      For Each sh In .Sheets
         If sh.Name <> meSh.Name Then
            With sh.Range("a:a")
               Set found = .Find(textToFind, LookIn:=xlValues, lookAt:=xlPart)

               If Not found Is Nothing Then
                  firstAddress = found.Address
                  Do
                     If found.Row > 72 Then
                        destRow = destRow + 1
                        meSh.Cells(destRow, "a") = found
                        meSh.Cells(destRow, "b") = found.Offset(-72, 0)
                        meSh.Cells(destRow, "c") = sh.Name
                        meSh.Cells(destRow, "d") = found.Row
                     End If
                     Set found = .FindNext(found)
                 Loop While Not found Is Nothing And found.Address <> firstAddress
               End If
            End With
         End If
      Next sh
   End With
End Sub

Regards,
Antonio

[Samoski]

See attached file where I added this macro:

Sub Macro1()
   Dim meSh As Worksheet
   Dim sh As Variant, textToFind As String
   Dim found As Range, firstAddress As String
   Dim destRow As Long
   
   destRow = 1
   textToFind = "TEST "
   With ThisWorkbook
      Set meSh = .ActiveSheet
      meSh.Range("2:" & Rows.Count).ClearContents
      For Each sh In .Sheets
         If sh.Name <> meSh.Name Then
            With sh.Range("a:a")
               Set found = .Find(textToFind, LookIn:=xlValues, lookAt:=xlPart)

               If Not found Is Nothing Then
                  firstAddress = found.Address
                  Do
                     If found.Row > 72 Then
                        destRow = destRow + 1
                        meSh.Cells(destRow, "a") = found
                        meSh.Cells(destRow, "b") = found.Offset(-72, 0)
                        meSh.Cells(destRow, "c") = sh.Name
                        meSh.Cells(destRow, "d") = found.Row
                     End If
                     Set found = .FindNext(found)
                 Loop While Not found Is Nothing And found.Address <> firstAddress
               End If
            End With
         End If
      Next sh
   End With
End Sub

Regards,
Antonio

Thanks Antonio,

I will test it on a real dataset today and let you know how it goes

[shg]

Samoski, please use the REPLY button, not the QUOTE button.