PDA

View Full Version : Solved: Extracting specific data



satyen
05-25-2008, 12:25 PM
Hello please can someone help. I have attached an Excel file with some code in Module 1, which I have started off. What needs to be done is also in the comments in the code. I have also populated the sheet from I1 to highlight what the output should be. (Doesn?t have to be in colour as shown)

The Number of rows will very and will not always be of the same number, if the code could be so that the output is in the same sheet using empty columns would be ideal.

I will then incorporate this bit of code into another large piece of code which will paste the information into another workbook.

Thanks in advance.

Bob Phillips
05-25-2008, 01:04 PM
Sub DoWhile()
Dim i As Long
Dim LastRow As Long
Dim fHeader As Boolean
Dim nLabel As String
Dim rng As Range

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns(2).Insert

i = 1
Set rng = .Range("A1")
Do

nLabel = .Cells(i + 1, "A").Value
Set rng = Union(rng, .Cells(i, "A"))
Set rng = Union(rng, .Cells(i + 1, "A"))
If fHeader Then Set rng = Union(rng, .Cells(i + 2, "A"))
fHeader = True
i = i + 3
Do

.Cells(i, "B").Value = nLabel
i = i + 1
Loop Until .Cells(i, "A").Value = ""
Set rng = Union(rng, .Cells(i, "A"))

i = i + 1
Loop Until i > LastRow

rng.EntireRow.Delete

With .Range("B1")

.Value = "Label"
.Underline = True
.Font.Bold = True
End With

End With
End Sub

satyen
05-25-2008, 01:31 PM
Thanks, but it should only extract data from section if the words 'Apple Report' exist in column A for that section.

Can this be added into the code to achieve this.

If .Cells(Lrow, "A").Value = "*Apple Report*" Then

Many Thanks

satyen
05-26-2008, 01:44 AM
Can anyone please help with incorporating this bit of criteria into the code XLD has kindly provided. I have had a go, but it doesn't seem to be working.
On another note can someone point me in the direction of how to correctly add code in here with the appropriate tags so that I can show what I have tried?

Thanks in advance.

Bob Phillips
05-26-2008, 01:51 AM
Sub DoWhile()
Dim i As Long
Dim LastRow As Long
Dim StartRow As Long
Dim fHeader As Boolean
Dim nLabel As String
Dim rng As Range

With ActiveSheet

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Columns(2).Insert

i = 1
Set rng = .Range("A1")
Do

If InStr(.Cells(i, "A").Value, "Apple Report") > 0 Then

nLabel = .Cells(i + 1, "A").Value
Set rng = Union(rng, .Cells(i, "A"))
Set rng = Union(rng, .Cells(i + 1, "A"))
If fHeader Then Set rng = Union(rng, .Cells(i + 2, "A"))
fHeader = True
i = i + 3
Do

.Cells(i, "B").Value = nLabel
i = i + 1
Loop Until .Cells(i, "A").Value = ""
Set rng = Union(rng, .Cells(i, "A"))
Else

StartRow = i
Do

i = i + 1
Loop Until .Cells(i, "A").Value = ""
Set rng = Union(rng, .Cells(StartRow, "A").Resize(i - StartRow + 1))
End If

i = i + 1
Loop Until i > LastRow

rng.EntireRow.Delete

With .Range("B1")

.Value = "Label"
.Font.Underline = True
.Font.Bold = True
End With

End With
End Sub

satyen
05-26-2008, 02:04 AM
Many Thanks. I now understand where this should have been inserted.

Bob Phillips
05-26-2008, 02:06 AM
On the code issue, preced the code with '[ vba ]' and end with '[ /vba ]' (but without the single quotes or the spaces that I included to show it).