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…
- Scan through all worksheets for the words “THIS IS A TEST”
- Copy that cell into a new worksheet (eg. A1)
- Go 72 cells up
- 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.
Once again, thanks for any help I recieve.
Here is a start. Your notes suggest that the words will only occur once in each sheet and that there will be a cell 72 rows back. I have included notes on checking these two items, but only sketchily.
Dim c As Range Dim s As Worksheet Dim sr As Worksheet ''For results Dim r1 As Long ''Row counter Dim i As Long ''Incidence counter Dim firstAddress As Variant ''New worksheet for results Set sr = ActiveWorkbook.Worksheets.Add r1 = 1 ''It might be better to use a named workbook For Each s In ActiveWorkbook.Worksheets ''Don't check results sheet If s.Name <> sr.Name Then ''From: http://msdn.microsoft.com/en-us/library/aa195730(v=office.11).aspx With s.UsedRange Set c = .Find("THIS IS A TEST", LookIn:=xlValues, LookAt:=xlWhole) i = 0 If Not c Is Nothing Then firstAddress = c.Address sr.Cells(r1, 1) = c.Value If c.Row - 72 > 0 Then sr.Cells(r1, 2) = s.Cells(c.Row - 72, c.Column) Else sr.Cells(r1, 2) = "Error" End If i = 1 r1 = r1 + 1 Do i = i + 1 Set c = .FindNext(c) Loop While Not c Is Nothing And c.Address <> firstAddress End If End With End If Debug.Print s.Name & " found: " & i Next