Extract Data Between Cell Ranges

[billmar]

I've come to a halt on a text file project, maybe someone can shed some light on my next steps.

2 questions using the following example, assume this data is in column A and appears many times with different numeric values beyween Data and Data1.

Data
1
1a
2
3
3a
4
5
6
7
8
9
Data1

1 - I need to create a macro that finds the first appearance of Data and counts the number of cells between Data and Data 1. If there are less than 8 no action is taken and it moves onto the next appearance of Data.

2 - If 8 or more cells are present, the macro extracts the value of 3 pre-identified cells and pastes their value in the 3 adjecent columns next to the cell containing the word Data.

The pre-identified cells, as an example could be, A=1st value after Data, B=4th value after data and C=5th value after data. In this case the result would be 1 3 3a


Any help or advice will be greatly appreciated.

Bill

[PY & Associates]

Range("A1").CurrentRegion.Select
Selection.Find(What:="Data#").Activate
Debug.Print ActiveCell.Row
Selection.Find(What:="Data#", After:=ActiveCell).Activate
Debug.Print ActiveCell.Row

Depending on pattern of Data cells, above will give you their row numbers.
The rest is programming exercise

"billmar" wrote:

>
> I've come to a halt on a text file project, maybe someone can shed some
> light on my next steps.
>
> 2 questions using the following example, assume this data is in column
> A and appears many times with different numeric values beyween Data and
> Data1.
>
> Data
> 1
> 1a
> 2
> 3
> 3a
> 4
> 5
> 6
> 7
> 8
> 9
> Data1
>
> 1 - I need to create a macro that finds the first appearance of Data
> and counts the number of cells between Data and Data 1. If there are
> less than 8 no action is taken and it moves onto the next appearance of
> Data.
>
> 2 - If 8 or more cells are present, the macro extracts the value of 3
> pre-identified cells and pastes their value in the 3 adjecent columns
> next to the cell containing the word Data.
>
> The pre-identified cells, as an example could be, A=1st value after
> Data, B=4th value after data and C=5th value after data. In this case
> the result would be 1 3 3a
>
>
> Any help or advice will be greatly appreciated.
>
> Bill
>
>
> --
> billmar
> ------------------------------------------------------------------------
> billmar's Profile: http://www.excelforum.com/member.php...o&userid=27359
> View this thread: http://www.excelforum.com/showthread...hreadid=468694
>
>

[Myrna Larson]

I'm not entirely clear on whether the cells contain the words "Data1",
"Data2", "Data3", etc, or just "Data". See the comment in the code if it's the
former. Also assume there will not be more than 1000 entries between
occurrences of the word "Data".

Change the constants MaxEntries, A, B, and C as necessary.

Option Explicit

Sub MoveData()
Dim D1 As Long
Dim D2 As Long
Dim D3 As Long
Dim Flag As String
Dim X As Variant

'offsets of values to be copied
Const A As Long = 1
Const B As Long = 4
Const C As Long = 5

'maximum number of data points between occurrences
'of the flag word
Const MaxEntries As Long = 1000
Const MinEntries As Long = 8

Flag = "Data"

'create a stopping point by writing the flag word
'at the bottom of the real data
D3 = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(D3, 1).Value = Flag

'if the flags are Data1, Data2, etc, uncomment the next line <<<<<
'Flag = Flag & "*"

'find the first occurrence
D1 = Application.Match(Flag, Cells(1, 1).Resize(MaxEntries, 1), 0)
If D1 = D3 Then
MsgBox Flag & " not found!"
Cells(D3, 1).ClearContents
Exit Sub
End If

Do
D2 = Application.Match(Flag, Cells(D1 + 1, 1).Resize(MaxEntries, 1), 0)
If D2 > MinEntries Then
X = Array(Cells(D1 + A, 1).Value, _
Cells(D1 + B, 1).Value, _
Cells(D1 + C, 1).Value)
Cells(D1, 2).Resize(1, 3).Value = X
End If

D1 = D1 + D2
If D1 = D3 Then Exit Do
Loop
Cells(D3, 1).ClearContents
End Sub


On Sun, 18 Sep 2005 20:25:46 -0500, billmar
<[email protected]> wrote:

>
>I've come to a halt on a text file project, maybe someone can shed some
>light on my next steps.
>
>2 questions using the following example, assume this data is in column
>A and appears many times with different numeric values beyween Data and
>Data1.
>
>Data
>1
>1a
>2
>3
>3a
>4
>5
>6
>7
>8
>9
>Data1
>
>1 - I need to create a macro that finds the first appearance of Data
>and counts the number of cells between Data and Data 1. If there are
>less than 8 no action is taken and it moves onto the next appearance of
>Data.
>
>2 - If 8 or more cells are present, the macro extracts the value of 3
>pre-identified cells and pastes their value in the 3 adjecent columns
>next to the cell containing the word Data.
>
>The pre-identified cells, as an example could be, A=1st value after
>Data, B=4th value after data and C=5th value after data. In this case
>the result would be 1 3 3a
>
>
>Any help or advice will be greatly appreciated.
>
>Bill

[R.VENKATARAMAN]

I have given a sub below which may be pedestrian but seems to work

THE FIRST ENTRY OF "DATA" IS IN A2 ----I.E. IN THE SECOND ROW

Public Sub test()
Range("a1").Activate
Dim dataa As Range
Dim i As Integer
Dim j As Integer
Cells.Find("data", lookat:=xlWhole, after:=ActiveCell).Activate
i = ActiveCell.Row
Set dataa = ActiveCell
'msgbox ActiveCell
Cells.Find("data1", lookat:=xlWhole, after:=ActiveCell).Activate
'msgbox ActiveCell
j = ActiveCell.Row
If j - i - 1 >= 8 Then
dataa.Offset(1, 1) = dataa.Offset(1, 0)
dataa.Offset(4, 1) = dataa.Offset(4, 0)
dataa.Offset(5, 1) = dataa.Offset(5, 0)
Else
End If


Do
Cells.Find("data", lookat:=xlWhole, after:=ActiveCell).Activate
i = ActiveCell.Row
Set dataa = ActiveCell

'msgbox ActiveCell
Cells.Find("data1", lookat:=xlWhole, after:=ActiveCell).Activate

'msgbox ActiveCell
j = ActiveCell.Row
If j - i - 1 >= 8 Then
dataa.Offset(1, 1) = dataa.Offset(1, 0)
dataa.Offset(4, 1) = dataa.Offset(4, 0)
dataa.Offset(5, 1) = dataa.Offset(5, 0)
Else
End If
Loop While i <> 2

End Sub
modify to suit you

perhaps you miight have received more sophisticated solution by this time.

--
remove $$$ from email addresss to send email



"billmar" <[email protected]> wrote in
message news:[email protected]...
>
> I've come to a halt on a text file project, maybe someone can shed some
> light on my next steps.
>
> 2 questions using the following example, assume this data is in column
> A and appears many times with different numeric values beyween Data and
> Data1.
>
> Data
> 1
> 1a
> 2
> 3
> 3a
> 4
> 5
> 6
> 7
> 8
> 9
> Data1
>
> 1 - I need to create a macro that finds the first appearance of Data
> and counts the number of cells between Data and Data 1. If there are
> less than 8 no action is taken and it moves onto the next appearance of
> Data.
>
> 2 - If 8 or more cells are present, the macro extracts the value of 3
> pre-identified cells and pastes their value in the 3 adjecent columns
> next to the cell containing the word Data.
>
> The pre-identified cells, as an example could be, A=1st value after
> Data, B=4th value after data and C=5th value after data. In this case
> the result would be 1 3 3a
>
>
> Any help or advice will be greatly appreciated.
>
> Bill
>
>
> --
> billmar
> ------------------------------------------------------------------------
> billmar's Profile:
http://www.excelforum.com/member.php...o&userid=27359
> View this thread: http://www.excelforum.com/showthread...hreadid=468694
>

[R.VENKATARAMAN]

I have given a sub below which may be pedestrian but seems to work

THE FIRST ENTRY OF "DATA" IS IN A2 ----I.E. IN THE SECOND ROW

Public Sub test()
Range("a1").Activate
Dim dataa As Range
Dim i As Integer
Dim j As Integer
Cells.Find("data", lookat:=xlWhole, after:=ActiveCell).Activate
i = ActiveCell.Row
Set dataa = ActiveCell
'msgbox ActiveCell
Cells.Find("data1", lookat:=xlWhole, after:=ActiveCell).Activate
'msgbox ActiveCell
j = ActiveCell.Row
If j - i - 1 >= 8 Then
dataa.Offset(1, 1) = dataa.Offset(1, 0)
dataa.Offset(4, 1) = dataa.Offset(4, 0)
dataa.Offset(5, 1) = dataa.Offset(5, 0)
Else
End If


Do
Cells.Find("data", lookat:=xlWhole, after:=ActiveCell).Activate
i = ActiveCell.Row
Set dataa = ActiveCell

'msgbox ActiveCell
Cells.Find("data1", lookat:=xlWhole, after:=ActiveCell).Activate

'msgbox ActiveCell
j = ActiveCell.Row
If j - i - 1 >= 8 Then
dataa.Offset(1, 1) = dataa.Offset(1, 0)
dataa.Offset(4, 1) = dataa.Offset(4, 0)
dataa.Offset(5, 1) = dataa.Offset(5, 0)
Else
End If
Loop While i <> 2

End Sub
modify to suit you

perhaps you miight have received more sophisticated solution by this time.

--
remove $$$ from email addresss to send email



"billmar" <[email protected]> wrote in
message news:[email protected]...
>
> I've come to a halt on a text file project, maybe someone can shed some
> light on my next steps.
>
> 2 questions using the following example, assume this data is in column
> A and appears many times with different numeric values beyween Data and
> Data1.
>
> Data
> 1
> 1a
> 2
> 3
> 3a
> 4
> 5
> 6
> 7
> 8
> 9
> Data1
>
> 1 - I need to create a macro that finds the first appearance of Data
> and counts the number of cells between Data and Data 1. If there are
> less than 8 no action is taken and it moves onto the next appearance of
> Data.
>
> 2 - If 8 or more cells are present, the macro extracts the value of 3
> pre-identified cells and pastes their value in the 3 adjecent columns
> next to the cell containing the word Data.
>
> The pre-identified cells, as an example could be, A=1st value after
> Data, B=4th value after data and C=5th value after data. In this case
> the result would be 1 3 3a
>
>
> Any help or advice will be greatly appreciated.
>
> Bill
>
>
> --
> billmar
> ------------------------------------------------------------------------
> billmar's Profile:
http://www.excelforum.com/member.php...o&userid=27359
> View this thread: http://www.excelforum.com/showthread...hreadid=468694
>

[billmar]

What a great response.....

Thanks PY, Myrna and R.V, you've gotten me going again. I have a lot here to work with and I can't thank you enough.

Bill