Need Help to Extract data from required tab as per condition

naveed raza · July 25th, 2013, 06:58 AM

Hi Everyone,

I have one workbook and that workbook contains total 15 Tabs and i want extract data only from
3 tabs ("Subscription","SIP","Back or Future date")

again from each tab we have different different calculation, below is the steps.

in all tabs row is starts from 7th row

1) workbook will open
2) add new tab and named as "99 Trxns"
3) next from "Subscription" tab Filter (contains 99) from C-Column and copy only some required column
like (See attached in required header tab) and paste in "99 Trxn" tab at range A1
4)next from "SIP" tab Filter (contains 99) from C-Column and copy only some required column
like (See attached in required header tab) and paste in "99 Trxn" tab at 2nd next empty row
5)next from "Back or Future date" tab Filter (contains 99) from D-Column and copy only some required column
like (See attached in required header tab) and paste in "99 Trxn" tab at 2nd next empty row.

Note: If possible please make VBA Code by using (Lbound,Ubound,select case,array) properties or else in your possible way.

Note: Required Columns Headers I mention in attached File in 1st tab.

I hope my explanation is understandable.

Thanks - Naveed.

Shasur · July 30th, 2013, 10:32 PM

Hi Naveed

Please post the code you had written/attempted till now and highlight the portion where you are stuck.

This would help others provide quick responses

Cheers
Shasur

naveed raza · August 1st, 2013, 03:20 AM

Dear Sir

After putting lot of efforts on this finally i prepared myself below is the code which is prepared by me.

Code:

Sub online_trxn()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
mymc = ActiveWorkbook.Name
arr = Array("Subscriptions", "SIP", "Back or Future Dated Trans")
Worksheets.Add
ActiveSheet.Name = "99 Trxn"
Set sh = Sheets("99 Trxn")
With sh
FR = .Range("A" & .Rows.Count).End(xlUp).Row
fc = .Range("A" & .Columns.Count).End(xlToLeft).Column
For i = LBound(arr, 1) To UBound(arr, 1)
    Select Case arr(i)
        Case "Subscriptions", "SIP"
            If Sheets(arr(i)).Range("A8").Value = "" Then
                Sheets(arr(i)).Range("A8").EntireRow.Delete
            End If
            LR = Sheets(arr(i)).Range("A" & Rows.Count).End(xlUp).Row
            vl = Application.WorksheetFunction.CountIf(Sheets(arr(i)).Range("C7:C" & LR), "*99*")
            If vl >= 1 Then
                Sheets(arr(i)).Range("C7").AutoFilter Field:=3, Criteria1:="*99*"
            Select Case arr(i)
                Case "Subscriptions"
                    hdrs = Array("A", "B", "C", "D", "E", "F", "H", "I", "J", "K", "N", "S", "T", "AJ", "AK", "AM", "AN", "AO")
                    For j = LBound(hdrs, 1) To UBound(hdrs, 1)
                        Sheets(arr(i)).Range(hdrs(j) & "7" & ":" & hdrs(j) & LR).Copy sh.Cells(FR, fc)
                        fc = fc + 1
                    Next
                    FR = .Range("A" & .Rows.Count).End(xlUp).Row + 2
                    fc = 1
                Case "SIP"
                    hdrs = Array("A", "B", "C", "D", "E", "F", "H", "U", "V", "W", "Y", "AC", "AD", "AG", "AH", "AJ", "AK", "AL")
                    For k = LBound(hdrs, 1) To UBound(hdrs, 1)
                        Sheets(arr(i)).Range(hdrs(k) & "7" & ":" & hdrs(k) & LR).Copy sh.Cells(FR, fc)
                        fc = fc + 1
                    Next
                    FR = .Range("A" & .Rows.Count).End(xlUp).Row + 2
                    fc = 1
            End Select
            Else
                MsgBox "No 99 Trxn in " & arr(i) & " Tab"
            End If

        Case "Back or Future Dated Trans"
            If Sheets(arr(i)).Range("A8").Value = "" Then
                Sheets(arr(i)).Range("A8").EntireRow.Delete
            End If
            LR = Sheets(arr(i)).Range("A" & Rows.Count).End(xlUp).Row
            vl = Application.WorksheetFunction.CountIf(Sheets(arr(i)).Range("D7:D" & LR), "*99*")
            If vl >= 1 Then
                    Sheets(arr(i)).Range("D7").AutoFilter Field:=4, Criteria1:="*99*"
                    hdrs = Array("A", "B", "D", "E", "F", "G", "I", "J", "K", "L", "O", "U", "V", "C", "AI", "AK", "AL", "AM")
                    For l = LBound(hdrs, 1) To UBound(hdrs, 1)
                        Sheets(arr(i)).Range(hdrs(l) & "7" & ":" & hdrs(l) & LR).Copy sh.Cells(FR, fc)
                        fc = fc + 1
                    Next
            Else
                MsgBox "No 99 Trxn in " & arr(i) & " Tab"
            End If

    End Select
Next
sh.Columns.AutoFit
MsgBox "Done Extracted !"
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

and one more thins sir can u please showed me how to attached workbook here in this forum.
and how can i mark this thread as solved

Shasur · August 24th, 2013, 03:28 AM

Hi

Glad to know that it worked. All the very best

You can upload the file to boxfiles etc and share the link here.

Cheers
Shasur