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).
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.