extract certain data ,,,

[febausa]

I need formula extract certain data and make new cells .


I want to extract (from columns A:F) and make new cells (columns H:M); that contain only the certain data extracted original data (columns A:F) are those rows that contain data in bold black color.


I attach the manually sample (columns H:M).


Thank you for your help.

 

[Nebu]

Hi:

What is the logic for behind selecting these particular rows, please elaborate.

Thanks

 

[Asheesh]

is it the second last row for every date that needs to be picked up

 

[Deepak]

In a VBA approach you could try this..

Sub extract()

Dim rng As Range
Dim h As Integer: h = 2

Set rng = [A2:A19]
[H1:M1].Value = [A1:F1].Value

For Each r In rng
    If r.Font.Bold = True Then
        r.Resize(, 6).Copy Cells(h, "H")
        h = h + 1
    End If
Next

End Sub

 

[Deepak]

Another logic...

Sub extract2()

Dim rng As Range
Dim h As Integer: h = 2
Dim i As Integer: i = 2

Set rng = [A2:A19]
[H1:M1].Value = [A1:F1].Value

For h = 6 To rng.Rows.Count Step 6
    Range("H" & i & ":M" & i).Value = Range("A" & h & ":F" & h).Value
        i = i + 1
Next

End Sub

 

[Deepak]

Non VBA this might be...

=INDIRECT(ADDRESS((ROW()-1)*6,COLUMN(A2)))

 

[febausa]

Non VBA this might be...

=INDIRECT(ADDRESS((ROW()-1)*6,COLUMN(A2)))

Your formula working good, Thank you

 

[febausa]

Non VBA this might be...

=INDIRECT(ADDRESS((ROW()-1)*6,COLUMN(A2)))

Hello Deepak:

I attach the manually example (columns H:M).

I could not use your formula with another input data.


Thank you for your help.

Febausa

 

[Deepak]

Hi febausa,

You haven't explained what's the logic behind the output!!!

However try the VBA code posted @ #4 OR

try below in I2 and drag right/down.

I2 =LOOKUP($H2,$A$2:$A$13,B$2:B$13)

or I2:m4

I2 = LOOKUP($H2,$A$2:$A$13,INDEX($B$2:$F$13,,COLUMN()-8))

 

[febausa]

Hi febausa,

You haven't explained what's the logic behind the output!!!

However try the VBA code posted @ #4 OR

try below in I2 and drag right/down.

I2 =LOOKUP($H2,$A$2:$A$13,B$2:B$13)

or I2:m4

I2 = LOOKUP($H2,$A$2:$A$13,INDEX($B$2:$F$13,,COLUMN()-8))

Hi Deepak:

Excuse for my mistake.

I attached new file for explain the logic.

Thank you for your help.

Febausa

 

[NARAYANK991]

Hi ,

Is this OK ?

Narayan

 

[Deepak]

Hi Deepak:

Excuse for my mistake.

I attached new file for explain the logic.

Thank you for your help.

Febausa

I think formula producing the correct output.

 

[febausa]

I think formula producing the correct output.

Hi Deepak:

Please resend your formula, because I don't receive it.

Thanks, Febausa

 

[Deepak]

Hi Deepak:

Please resend your formula, because I don't receive it.

Thanks, Febausa

i2 =LOOKUP($H2,$A$2:$A$13,INDEX($B$2:$F$13,,COLUMN()-8))

 

[febausa]

In a VBA approach you could try this..

Sub extract()

Dim rng As Range
Dim h As Integer: h = 2

Set rng = [A2:A19]
[H1:M1].Value = [A1:F1].Value

For Each r In rng
    If r.Font.Bold = True Then
        r.Resize(, 6).Copy Cells(h, "H")
        h = h + 1
    End If
Next

End Sub

Hi Deepak:

Your recommendation #4 VBA working well, thankyou for your help.

Febausa

 

[febausa]

Hi Deepak:

Your recommendation in VBA working very well , but I could not make successful changes in its original formula.

I solicit your help in attached example.

Thank you,

Febausa

 

[Abhiishek]

Hi febausa
Please see attached sheet.

 

[febausa]

Hi febausa
Please see attached sheet.

Hi Abhiishek:

Thank you your formula working well,

Febausa

 

[febausa]

In a VBA approach you could try this..

Sub extract()

Dim rng As Range
Dim h As Integer: h = 2

Set rng = [A2:A19]
[H1:M1].Value = [A1:F1].Value

For Each r In rng
    If r.Font.Bold = True Then
        r.Resize(, 6).Copy Cells(h, "H")
        h = h + 1
    End If
Next

End Sub

Deepak:

Thank you , your VBA formula working ver well.

Febausa

 

[Deepak]

Deepak:

Thank you , your VBA formula working ver well.

Febausa

Thnx buddy..