Excel select data from mess

[gtxy20]

Hello all,

I have a really messy Excel file and was wondering how I would go about selecting data based on the following example (VBA code would be good):

A B C D E
value
1 n 100
2 n 200
3 n 200
4 n 400

some garbage in cells here

value
5 n 100
6 n 200
7 n 200
8 n 400

some garbage in cells here

value
9 n 100
10 n 200
11 n 200
12 n 400

some garbage in cells here

value
13 n 100
14 n 200
15 n 200
16 n 400

Effectively I need to get so that I have the following formatted:
A B C
value
1 n 100
2 n 200
3 n 200
4 n 400
5 n 100
6 n 200
7 n 200
8 n 400
9 n 100
10 n 200
11 n 200
12 n 400
13 n 200
14 n 200
15 n 400
16 n 400

Is there any way that I can search the whole sheet for the word "value" and then retrieve all of the rows beneath "value" until it hits a blank, select the values column and the two colums to the left for each non blank row and then append to another worksheet.

Thanks for any advice -- I am stumped.

Celeste.

[mikerickson]

I think this might do what you want. You may have to ajust the sheet names to meet your situation.

Sub test()
Dim foundCell As Range, firstFound As Range
Dim oneBatch As Range
Dim destinationRange As Range
Set destinationRange = ThisWorkbook.Sheets("sheet2").Range("a1")
destinationRange.Parent.Cells.ClearContents
With ThisWorkbook.Sheets("sheet1")
    Set foundCell = .Cells.Find(What:="value", after:=.Range("a1"), LookIn:=xlValues, _
                         LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Nothing Is foundCell Then Exit Sub
    Set firstFound = foundCell
    Do
        Set oneBatch = Application.Intersect(Range(foundCell, foundCell.End(xlDown).Offset(0, -2)), .UsedRange)
        Set destinationRange = destinationRange.Parent.Range("c65536").End(xlUp).Offset(1, -2)
        Set destinationRange = Range(destinationRange, destinationRange.Cells(oneBatch.Rows.Count, oneBatch.Columns.Count))
        destinationRange.Value = oneBatch.Value
        Set foundCell = .Cells.FindNext(after:=foundCell)
    Loop While firstFound.Address <> foundCell.Address
End With
destinationRange.Parent.Range("1:1").Delete shift:=xlUp
End Sub

[p45cal]

mikerickson, you going to hate me for this, but while I was scanning down your code I saw the '-2' in the offset parts of some lines puzzled me. The answer turned out to be because the cells with 'value' were to be found in column C (more precisely, over the third column of data). Looking at the original post, what justifies this is that column C has values in it (unless there are a couple of hidden spaces or something in the original post). A fair enough assumption, but not one that I'd be happy to rely on. So a couple of suggestions if 'value' turns out to be in column A:

1. Change
[vba]Set oneBatch = Application.Intersect(Range(foundCell, foundCell.End(xlDown).Offset(0, -2)), .UsedRange)[/vba] to
[vba]Set oneBatch = Application.Intersect(Range(foundCell.Offset(1), foundCell.End(xlDown).Offset(0, 2)), .UsedRange)[/vba] Also this only includes rows below (not including) the foundcell row, since the OP only wanted 'value' to appear once on the top of the resulting list ('Offset(1)' in red above).

2. Because the above now never copies over the cell found with 'value' in it, instead of your last line of code which deletes the blank top row:
[vba]destinationRange.Parent.Range("1:1").Delete shift:=xlUp[/vba]I put the word 'value' in cell A1:
[vba]destinationRange.Parent.Cells(1, 1) = "value"[/vba]

Optionally 3. change
[vba]Set destinationRange = destinationRange.Parent.Range("c65536").End(xlUp).Offset(1, -2)[/vba]to[vba]Set destinationRange = destinationRange.Parent.Range("a65536").End(xlUp).Offset(1)[/vba]
I started this post not realising that your code was able to cope with finding the data in any column and had started adjusting the code to cope regardless of which column 'value' was to be found in, but this would only have worked with data in columns A, B and C, and would have lost your code's greater freedom, so I opted to keep it simple. Let's hope the OP doesn't come back to us with "Actually, 'value' is at the top of the second column".

[gtxy20]

Hi Guys,

The first example actually worked well - thank you so much.

As for the "value" indicator - it can occur in any column within the complete sheet - so effectively it could fall in column A, B, C,..... throughout the worksheet. In fact it can also be represented on the same row but in two or more columns with different data falling underneath in the same fashion.

I am just going through some examples to see that all instances are captured.

I can upload a sample of what I need to work with if that helps.

Thanks so much for this help.

Celeste.

[mikerickson]

If "value" ocures in column B,
"select the values column and the two colums to the left" becomes difficult.

Uploading your current spreadsheet would help us figure out where the treasure is to be found within the mess.

[gtxy20]

I am beginning to realize the problem with Left now.

Attached is an example - I will be woring with multiple worksheets within a workbook and each worksheet wil not layout the same way so the fields where information is held has the potential to be different for each worksheet.

In the attached sheet1 is a sample of a potential supplied worksheet and sheet2 is what I hope to generate.

Thanks so much for you comments and help.

C.

[mikerickson]

The sample sheet has "any" as the identifying name (rather than "value"). If on each sheet, these are all in the same column, this should do the job. The loop for looping through various sheets of nasty data is indicated.

Sub demo()
Dim sourceSheet As Worksheet
Dim destinationStart As Range
Set destinationStart = ThisWorkbook.Sheets(2).Range("a1")
Set destinationStart = destinationStart.Range("a1")
Range(destinationStart, destinationStart.Offset(0, 3)).EntireColumn.ClearContents
sourceSheet = ThisWorkbook.Sheets(1)
Rem begin loop through source sheets
    Call moveAny(sourceSheet, destinationStart.EntireColumn.Range("a65536").End(xlUp))
Rem loop
End Sub

Sub moveAny(sourceSheet As Worksheet, destinationPlace As Range)
Dim foundCell As Range, baseSheet As Worksheet
Dim dataRange As Range
Dim oneArea As Range
Set baseSheet = ActiveSheet
With sourceSheet
    .Activate
    .AutoFilterMode = False
    Set foundCell = Nothing
    On Error Resume Next
        Set foundCell = Cells.Find(What:="any", After:=.Range("a1"), LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    On Error GoTo 0
    If Not (foundCell Is Nothing) Then
        
        Set dataRange = Range(foundCell, foundCell.Offset(0, 3)).EntireColumn
        Set dataRange = Application.Intersect(.UsedRange, dataRange)
        dataRange.AutoFilter Field:=1, Criteria1:="Any"
        For Each oneArea In Application.Intersect(dataRange, .Cells.SpecialCells(xlCellTypeVisible)).Areas
            oneArea.Copy Destination:=destinationPlace
        Next oneArea
        .AutoFilterMode = False
    End If
End With
baseSheet.Activate
End Sub