Macro to find specific text in column and copy certain cells in same row to different sheet

[jlevesquire]

Hey all,

Although I am not a complete newbie to Excel, I have no clue on how to work macros or VBA, so please bare with me if this doesn't make sense or is super easy.

I have a workbook with multiple sheets named by month and year that I use to keep track of loans I work with at a bank. In these sheets I have info such as:
Column B = due date
Column D = loan# A
Column E = loan# B
Column F = status
Column H = followup needed
(Columns A,C, and G aren't important for the current need)

What I am trying to do is create a main sheet (TRACKER) that all I will have to do is press a macro button and it will pull info for each loan that is in a pending status.

I need a macro that will search column F (Status) on all sheets and find each instance of "Pending" and once that is done, copy rows B,D,E, and H in each "Pending" instance and copy them to their designated area on my TRACKER sheet. After that is done I need it to continue to the next "pending" instance and do the same on the next available line on my TRACKER sheet.

The overall goal would be that everyday I can press the macro and it will repopulate the sheet with the current pending items (as each day I will change pending status' to complete and no longer need to track it the next day).

I already have the tracker sheet set up and ready to go with the spaces as follows:
Column G&H = Merged cells where due date will need to go
Column I&J = Merged cells where loan# A will need to go
Column K&L = Merged cells where loan# B will need to go
Column M thru S = Merged cells where followup needed will need to go

Hopefully this is understandable, if anyone can help me or has any questions to help clarify please let me know.

 

[hiker95]

jlevesquire,

Welcome to the MrExcel forum.

What version of Excel are you using?

You will generally get much more help (and faster) in this forum if you can post your small samples (sensitive data scrubbed/removed/changed) (what you have and what you expect to achieve) directly in the forum.

Can we have screenshots of 2 or 3 of the worksheets, and a screenshot of worksheet TRACKER (before and after)?

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

 

[rockclimber112358]

Hey,

I'm not a VBA pro just yet, but here's some code that (almost) does what you want:

    Dim shts As Worksheet, i As Integer
    Application.ScreenUpdating = False
    'Sheets("Tracker").Range("A2:" & Columns.Count & ":" & Rows.Count).Delete
    i = 1
    For Each shts In Worksheets
        If shts.Name Like "Loan*" Then
            shts.UsedRange.AutoFilter Field:=6, Criteria1:="Pending"
            Sheets(i).Range(Sheets(i).Range("B1").Offset(1), Sheets(i).Range("B1").End(xlDown)).Copy _
                Sheets("Tracker").Range("G" & Rows.Count).End(xlUp).Offset(1)
            Sheets(i).Range(Sheets(i).Range("D1").Offset(1), Sheets(i).Range("D1").End(xlDown)).Copy _
                Sheets("Tracker").Range("I" & Rows.Count).End(xlUp).Offset(1)
            Sheets(i).Range(Sheets(i).Range("E1").Offset(1), Sheets(i).Range("E1").End(xlDown)).Copy _
                Sheets("Tracker").Range("K" & Rows.Count).End(xlUp).Offset(1)
            Sheets(i).Range(Sheets(i).Range("H1").Offset(1), Sheets(i).Range("H1").End(xlDown)).Copy _
                Sheets("Tracker").Range("M" & Rows.Count).End(xlUp).Offset(1)
            shts.UsedRange.AutoFilter
        End If
    i = i + 1
    Application.ScreenUpdating = True
    Next

You can remove the commented row, and then this macro will delete all the data currently in the sheet Tracker (or, leave it commented, and it'll paste below it). One thing about this macro though: it won't paste into merged cells (still looking into that). Also, it assumes that the sheets with the data on them are named "Loan ..." where ... is anything. Let me know if you want a different condition there... Hope this helps!

Josh

 

[jlevesquire]

hiker95,

I am using Excel 2007
Not sure how much this will help but I have a PDF of the tracker at http://www.box.com/s/9o5m939fdhxfajzb8zuq
And a PDF of what one of the sheets will look like at http://www.box.com/s/5p0zdkbaod5b9gp40rri
Thanks for the advice as I am new to all of this and want to make sure I am giving as much helpful info as possible.

Josh,
If you can see the tracker in the link above it does have all merged cells, can we compensate for this?

I appreciate all the help

 

[hiker95]

jlevesquire,


I can not use the PDF's.


You will generally get much more help (and faster) in this forum if you can post your small samples (sensitive data scrubbed/removed/changed) (what you have and what you expect to achieve) directly in the forum.

To attach screenshots, see below in my Signature block: Post a screen shot with one of these:

If you are not able to give us screenshots, see below in my Signature block: You can upload your workbook to Box Net, mark the workbook for sharing, and provide us with a link to your workbook.

 

[rockclimber112358]

Hey, sorry for the slow reply. I figured out how to merge the cells. Let me know if this does what you wanted:

Sub CopyLoanData()
    Dim shts As Worksheet, i As Integer, n As Integer
    Application.ScreenUpdating = False
    Sheets("Tracker").Range("A2:" & Columns.Count & ":" & Rows.Count).Delete
    i = 1
    For Each shts In Worksheets
        If shts.Name Like "Loan*" Then
            shts.UsedRange.AutoFilter Field:=6, Criteria1:="Pending"
            Sheets(i).Range(Sheets(i).Range("B1").Offset(1), Sheets(i).Range("B1").End(xlDown)).Copy _
                Sheets("Tracker").Range("G" & Rows.Count).End(xlUp).Offset(1)
            Sheets(i).Range(Sheets(i).Range("D1").Offset(1), Sheets(i).Range("D1").End(xlDown)).Copy _
                Sheets("Tracker").Range("I" & Rows.Count).End(xlUp).Offset(1)
            Sheets(i).Range(Sheets(i).Range("E1").Offset(1), Sheets(i).Range("E1").End(xlDown)).Copy _
                Sheets("Tracker").Range("K" & Rows.Count).End(xlUp).Offset(1)
            Sheets(i).Range(Sheets(i).Range("H1").Offset(1), Sheets(i).Range("H1").End(xlDown)).Copy _
                Sheets("Tracker").Range("M" & Rows.Count).End(xlUp).Offset(1)
            shts.UsedRange.AutoFilter
        End If
    i = i + 1
    Next
    Application.ScreenUpdating = True
    Range("G2", Range("G" & Rows.Count).End(xlUp).Offset(0, 1)).Select
    n = Selection.Rows.Count
    For i = 1 To n
        Selection.Range(Cells(i, 1), Cells(i, 2)).Merge
    Next i
    Range("I2", Range("I" & Rows.Count).End(xlUp).Offset(0, 1)).Select
    For i = 1 To n
        Selection.Range(Cells(i, 1), Cells(i, 2)).Merge
    Next i
    Range("K2", Range("K" & Rows.Count).End(xlUp).Offset(0, 1)).Select
    For i = 1 To n
        Selection.Range(Cells(i, 1), Cells(i, 2)).Merge
    Next i
    Range("M2", Range("M" & Rows.Count).End(xlUp).Offset(0, 6)).Select
    For i = 1 To n
        Selection.Range(Cells(i, 1), Cells(i, 7)).Merge
    Next i
End Sub

 

[jlevesquire]

Okay, here you go http://www.box.com/s/gto5xcrj4l7ky5gcpl76

Thanks!

 

[hiker95]

jlevesquire,

Thanks for the workbook.

So that we can get it right the first time, can we have another workbook, with at least two monthly worksheets, and the Tracker worksheet manually completed by you for the number of monthly worksheets present.

 

[jlevesquire]

Hey,

Actually with a little help from a coworker, rockclimbers coding worked perfect. I really appreciate everyone's help on this, this should help save my coworkers a lot of headache. Thank you a ton!

 

[rockclimber112358]

Great, glad to hear it worked out for you!