Data Extraction from an Array

[brmeeke]

Hi

I need to extract data from a series of columns to build a new array. Please look at the table below:

A	B	C	D	E	F
Error Num	Row Key	Message	Error Num	Row Key	Message
0	0	99	0	0	99
0	0	99	0	0	99
1	2.07.1	13	0	0	99
0	0	99	0	0	99
0	0	99	4	2.09.4	16
0	0	99	0	0	99
0	0	99	0	0	99
2	2.12.2	13	0	0	99
0	0	99	0	0	99
3	2.14.3	13	0	0	99

<tbody>
</tbody>

Column A & D have an ascending error number. I need to find the non-zero rows from Column A & D and then pick up the data that is in the next two columns. The objective is to create a new array that looks like this:

1	2.07.1	13
2	2.12.2	13
3	2.14.3	13
4	2.09.4	16

<tbody>
</tbody>

My first thought was to capture the Address of the row and column that holds the error number, and then use Offsets to extract the information from the other two rows. I hoped that I could use the Match function in an Array formula and present columns A & D as one continuous array but I could not figure out a syntax that Match would accept.

Does anyone have any suggestions?


Thank you
Brian

 

[jim may]

Sure, why not loop thru columns A and D and where only those whose value is greater than 0 (zero) , use the Offset(, 2).value to get row.key values...

 

[cooper645]

Currently, this is what I have; still need to get it all in 1 column in order though

Option Explicit

Sub x1085137()
'https://www.mrexcel.com/forum/excel-questions/1085137-data-extraction-array.html
Dim LRow As Long, r As Integer, c As Integer


Cells.Copy
Sheets.Add after:=ActiveSheet
ActiveSheet.Paste


LRow = Cells(Rows.Count, "A").End(xlUp).Row


For c = 1 To 4 Step 3
    For r = LRow To 2 Step -1
        If Cells(r, c).Value = 0 Then
            Range(Cells(r, c), Cells(r, c + 2)).Delete (xlUp)
        End If
    Next r
Next c


End Sub

 

[cooper645]

Now with sorting

Option Explicit

Sub x1085137()
'https://www.mrexcel.com/forum/excel-questions/1085137-data-extraction-array.html
Dim LRow As Long, LRow2 As Long, r As Integer, c As Integer


Application.ScreenUpdating = False


Cells.Copy
Sheets.Add after:=ActiveSheet
ActiveSheet.Paste


LRow = Cells(Rows.Count, "A").End(xlUp).Row


For c = 1 To 4 Step 3
    For r = LRow To 2 Step -1
        If Cells(r, c).Value = 0 Then
            Range(Cells(r, c), Cells(r, c + 2)).Delete (xlUp)
        End If
    Next r
Next c


LRow = Cells(Rows.Count, "D").End(xlUp).Row
LRow2 = Cells(Rows.Count, "A").End(xlUp).Row + 1


Range(Cells(2, 4), Cells(LRow, 6)).Cut Cells(LRow2, 1)


Range("A2", Range("A2").End(xlDown)).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlNo


Range("D1:F1").ClearContents
Range("A1").Select
Application.ScreenUpdating = True
End Sub

 

[igold]

Hi,

Does this get you any closer to where you need to be...

Sub test()


    Dim arr1, arr2, cmp
    Dim lRow As Long, a As Long, b As Long, ct As Long
    
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    ct = 1
    arr1 = Range("A2:C" & lRow)
    arr2 = Range("D2:F" & lRow)
    ReDim cmp(1 To lRow, 1 To 3)
    
    For a = LBound(arr1) To UBound(arr1)
        If Not (arr1(a, 1)) = 0 Then
            cmp(ct, 1) = arr1(a, 1)
            cmp(ct, 2) = arr1(a, 2)
            cmp(ct, 3) = arr1(a, 3)
            ct = ct + 1
        End If
    Next
    For b = LBound(arr2) To UBound(arr2)
        If Not (arr2(b, 1)) = 0 Then
            cmp(ct, 1) = arr2(b, 1)
            cmp(ct, 2) = arr2(b, 2)
            cmp(ct, 3) = arr2(b, 3)
            ct = ct + 1
        End If
    Next
    Range("I2").Resize(ct - 1, 3) = cmp
    
End Sub

 

[brmeeke]

Thank you for your replies. I agree that with a bit of VBA code, I could loop through the cells and perform the necessary steps. However, my spreadsheet does not have any VBA code today and I was hoping that I could generate the desired result without having to go that route. (Sorry if I am being too simplistic)

As far as the sorting issue is concerned, I should have noted that I do not care. I am going to take the extracted array and re-sort it a couple of different ways before I show the results to the end-user. I just need to figure out a way to extract the non-zero error rows first.

Again - appreciate your help.


Brian

 

[DanteAmor]

With formulas it could be like this:

	A	B	C	D	E	F	G	H	I	J	K	L
1	Error num	Row key	Message	Error num	Row key	Message		Refer	Array Formula	Error num	Row key	Message
2	0	0	99	0	0	99		0	$A$4	1	2.07.1	13
3	0	0	99	0	0	99		0	$A$9	2	2.12.2	13
4	1	2.07.1	13	0	0	99		$A$4	$A$11	3	2.14.3	13
5	0	0	99	0	0	99		0	$D$6	4	2.09.4	16
6	0	0	99	4	2.09.4	16		0
7	0	0	99	0	0	99		0
8	0	0	99	0	0	99		0
9	2	2.12.2	13	0	0	99		$A$9
10	0	0	99	0	0	99		0
11	3	2.14.3	13	0	0	99		$A$11
12								0
13								0
14								0
15								0
16								$D$6
17								0
18								0
19								0
20								0
21								0

<tbody>
</tbody>

Formulas

Cell Formula H2 =IF(A2=0,0,ADDRESS(ROW(A2),COLUMN(A2))) ... Copy to H11 H12 =IF(D2=0,0,ADDRESS(ROW(D2),COLUMN(D2))) Copy to H21 Array Formula I2 {=IFERROR(INDEX($H$1:$H$21,SMALL(IF($H$2:$H$21>0,ROW()),ROW()-1)),"")} Formula J2 =IFERROR(INDIRECT(I2),"") K2 =IFERROR(OFFSET(INDIRECT(I2),0,1),"") L2 =IFERROR(OFFSET(INDIRECT(I2),0,2),"") Copy to row 21 <tbody> </tbody>

<tbody>
</tbody>

 

[DanteAmor]

If you are going to use a single column then

	A	B	C	D	E	F	G
1	Error num	Row key	Message		Error num	Row key	Message
2	0	0	99		1	2.07.1	13
3	0	0	99		2	2.12.2	13
4	1	2.07.1	13		3	2.14.3	13
5	0	0	99		4	2.09.4	16
6	0	0	99
7	0	0	99
8	0	0	99
9	2	2.12.2	13
10	0	0	99
11	3	2.14.3	13
12	0	0	99
13	0	0	99
14	0	0	99
15	0	0	99
16	4	2.09.4	16
17	0	0	99
18	0	0	99
19	0	0	99
20	0	0	99
21	0	0	99

<tbody>
</tbody>

Formulas

Cell Array Formula E2 {=IFERROR(INDEX(A$1:A$21,SMALL(IF($A$2:$A$21>0,ROW()),ROW()-1)),"")} F2 {=IFERROR(INDEX(B$1:B$21,SMALL(IF($A$2:$A$21>0,ROW()),ROW()-1)),"")} G2 {=IFERROR(INDEX(C$1:C$21,SMALL(IF($A$2:$A$21>0,ROW()),ROW()-1)),"")} <tbody> </tbody>

Copy to row 21, To accept press Shift + Control + Enter

<tbody>
</tbody>

---
Just in case, I put the macro

Sub arreglo()
    i = 2
    For Each d In Range("A2:A11, D2:D11")
        If d.Value > 0 Then Cells(i, "H").Resize(1, 3).Value = d.Resize(1, 3).Value: i = i + 1
    Next
End Sub

 

[brmeeke]

thanks for the suggestion of the single column. I already thought about that and it is an option however the array is quite large so the number of rows required to work with this data as a single column would be quite significant.

 

[igold]

@DanteAmor

Nice!!

Just in case, I put the macro

Sub arreglo()
    i = 2
    For Each d In Range("A2:A11, D2:D11")
        If d.Value > 0 Then Cells(i, "H").Resize(1, 3).Value = d.Resize(1, 3).Value: i = i + 1
    Next
End Sub