Extract data from an array and populate new array but only keep certain columns

[SharmaAntriksh]

[TABLE="class: grid, width: 500, align: left"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Serial Number[/TD]
[TD]Date[/TD]
[TD]Price[/TD]
[TD]Address[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]1[/TD]
[TD]1/1/2019[/TD]
[TD]123[/TD]
[TD]abc[/TD]
[TD]xyz[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]2[/TD]
[TD]1/1/2019[/TD]
[TD]123[/TD]
[TD]abc[/TD]
[TD]xyz[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]3[/TD]
[TD]1/1/2019[/TD]
[TD]123[/TD]
[TD]abc[/TD]
[TD]xyz[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]4[/TD]
[TD]1/1/2019[/TD]
[TD]123[/TD]
[TD]abc[/TD]
[TD]xyz[/TD]
[/TR]
</tbody>[/TABLE]









i have data that looks like this, i am trying to load this into an array and populate a new array with the data where name is "A" i want the new array to only have the columns "Name", "Price", and "Comments". i am able to extract the rows with the help of below code but i am not sure how to keep only the required columns while the loop is running

Sub WorkingWithArrays()
    Dim OriAry() As Variant 'Will store original data
    Dim NewAry() As Variant 'will have the data after satisfying a condition
    Dim i As Integer, Counter As Integer, k As Integer
    
    OriAry = Sheet2.Range("A1:F5")
    
    For i = LBound(OriAry, 1) To UBound(OriAry, 1)
        If OriAry(i, 1) = "A" Then
            Counter = Counter + 1


            ReDim Preserve NewAry(LBound(OriAry, 2) To UBound(OriAry, 2), 1 To Counter)
            For k = LBound(OriAry, 2) To UBound(OriAry, 2)
                NewAry(k, Counter) = OriAry(i, k)
            Next k
        End If
    Next i
    
    Sheet3.Range("A2", Sheet3.Range("A2").Offset(Counter - 1, UBound(NewAry, 1) - 1)) = Application.Transpose(NewAry)
End Sub

 

[Legacy 436357]

This can be done with index/ match formulas

Excel Workbook
	B	C	D	E	F	G
2	Name	email	Contact No.	Data 1	Data 2	Data 3
3	John	john@gmail.com	555-555-5555	red	box	gadget
4	Mary	mary@gmail.com	555-555-1234
5	Susan	susan@gmail.com	444-444-4444
Sheet1

Sheet2

	C	D	E	F	G	H
Susan	susan@gmail.com	444-444-4444
Mary	mary@gmail.com	555-555-1234
Mary	mary@gmail.com	555-555-1234
John	john@gmail.com	555-555-5555	red	box	gadget

[TD="align: center"]3[/TD]
[TD="bgcolor: #99ccff"]Name[/TD]
[TD="bgcolor: #99ccff"]email[/TD]
[TD="bgcolor: #99ccff"]Contact No.[/TD]
[TD="bgcolor: #99ccff"]Data 1[/TD]
[TD="bgcolor: #99ccff"]Data 2[/TD]
[TD="bgcolor: #99ccff"]Data 3[/TD]

[TD="align: center"]4[/TD]

[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]

[TD="align: center"]5[/TD]

[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]

[TD="align: center"]6[/TD]

[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]
[TD="align: right"]0[/TD]

[TD="align: center"]7[/TD]

Spreadsheet Formulas

Cell Formula D4 {=IFERROR(INDEX(Sheet1!C$3:C$500,MATCH($C4,Sheet1!$B$3:$B$500,0)),"")} E4 {=IFERROR(INDEX(Sheet1!D$3:D$500,MATCH($C4,Sheet1!$B$3:$B$500,0)),"")} F4 {=IFERROR(INDEX(Sheet1!E$3:E$500,MATCH($C4,Sheet1!$B$3:$B$500,0)),"")} G4 {=IFERROR(INDEX(Sheet1!F$3:F$500,MATCH($C4,Sheet1!$B$3:$B$500,0)),"")} H4 {=IFERROR(INDEX(Sheet1!G$3:G$500,MATCH($C4,Sheet1!$B$3:$B$500,0)),"")} D5 {=IFERROR(INDEX(Sheet1!C$3:C$500,MATCH($C5,Sheet1!$B$3:$B$500,0)),"")} E5 {=IFERROR(INDEX(Sheet1!D$3:D$500,MATCH($C5,Sheet1!$B$3:$B$500,0)),"")} F5 {=IFERROR(INDEX(Sheet1!E$3:E$500,MATCH($C5,Sheet1!$B$3:$B$500,0)),"")} G5 {=IFERROR(INDEX(Sheet1!F$3:F$500,MATCH($C5,Sheet1!$B$3:$B$500,0)),"")} H5 {=IFERROR(INDEX(Sheet1!G$3:G$500,MATCH($C5,Sheet1!$B$3:$B$500,0)),"")} D6 {=IFERROR(INDEX(Sheet1!C$3:C$500,MATCH($C6,Sheet1!$B$3:$B$500,0)),"")} E6 {=IFERROR(INDEX(Sheet1!D$3:D$500,MATCH($C6,Sheet1!$B$3:$B$500,0)),"")} F6 {=IFERROR(INDEX(Sheet1!E$3:E$500,MATCH($C6,Sheet1!$B$3:$B$500,0)),"")} G6 {=IFERROR(INDEX(Sheet1!F$3:F$500,MATCH($C6,Sheet1!$B$3:$B$500,0)),"")} H6 {=IFERROR(INDEX(Sheet1!G$3:G$500,MATCH($C6,Sheet1!$B$3:$B$500,0)),"")} D7 {=IFERROR(INDEX(Sheet1!C$3:C$500,MATCH($C7,Sheet1!$B$3:$B$500,0)),"")} E7 {=IFERROR(INDEX(Sheet1!D$3:D$500,MATCH($C7,Sheet1!$B$3:$B$500,0)),"")} F7 {=IFERROR(INDEX(Sheet1!E$3:E$500,MATCH($C7,Sheet1!$B$3:$B$500,0)),"")} G7 {=IFERROR(INDEX(Sheet1!F$3:F$500,MATCH($C7,Sheet1!$B$3:$B$500,0)),"")} H7 {=IFERROR(INDEX(Sheet1!G$3:G$500,MATCH($C7,Sheet1!$B$3:$B$500,0)),"")}

Formula Array: Produce enclosing { } by entering formula with CTRL+SHIFT+ENTER!

 

[SharmaAntriksh]

Hey, thank you, but i need to implement a VBA solution only as the data in future will be coming from multiple excel files so i want user to not worry about applying formulas. Also anyone who comments after this please note that i only want suggestions/help related only to VBA code and not for Excel functions.

 

[MickG]

Perhaps something like this:-

[COLOR="Navy"]Sub[/COLOR] MG07Nov25
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Ray = Sheets("Sheet2").Range("A1").CurrentRegion.Resize(, 6)
ReDim nRay(1 To UBound(Ray, 1), 1 To 3)
[COLOR="Navy"]For[/COLOR] n = 1 To UBound(Ray, 1)
    [COLOR="Navy"]If[/COLOR] Ray(n, 1) = "A" Or n = 1 [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        nRay(c, 1) = Ray(n, 1)
        nRay(c, 2) = Ray(n, 4)
        nRay(c, 3) = Ray(n, 6)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] n
 Sheets("Sheet3").Range("A1").Resize(c, 3) = nRay

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick