VBA - Excel 2007 - Modify current code

Hi,

I have a workbook, that highlights and moves data back and forth between tabs. Users asked for 3 new columns thus:


1.

When double clicking into a row in Column A, I need the highlighting to extend to Column X now and not stop at U.

2.

When the 'Move' buttons on either 'Master' or 'Retrieval' tabs are clicked, I need the content all the way to Column X moved now instead of it stopping at U.

3.

Need the movement to not mess with the formatting either.  It now hoses up my vertical lines too.

99% of code is done, just can't get over hump...Attached is my file.  I got everything else working I believe, but can't figure out the actual moving of the data.
EE-Template-NewV21-Stripped-Work.zip
elwayisgodAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

kgerbChief EngineerCommented:
Try this.  It seems to work ok.  We can adjust if necessary.
Sub MoveToMaster()
Dim r As Range
For Each r In Range("A15", Cells(Rows.Count, "A").End(xlUp))
    If r = "Move To Master" Then r.EntireRow.Copy Sheets("Master").Cells(Rows.Count, "A").End(xlUp).Offset(1)
Next r
End Sub

Open in new window

Kyle
elwayisgodAuthor Commented:
I really need to know where in this code I need to make changes.  Don't want to change current code, just expand it.


Open in new window

Option Explicit

Sub TransferData()
Dim wsSrc As Worksheet
Dim wsDst As Worksheet
Dim rngData As Range
Dim rngResult As Range
Dim rngHeaders As Range
Dim cl1 As Range
Dim cl2 As Range
Dim NoCols As Long
Dim rngDst As Range
Dim rngCrit As Range
Dim LastRow As Long
Dim I As Long

    Application.ScreenUpdating = False

    Select Case Application.Caller
        Case "Button 1"
            Set wsDst = Worksheets("Master")
            Set wsSrc = Worksheets("Retrieval")

        Case "Button 2"
            Set wsDst = Worksheets("Retrieval")
            Set wsSrc = Worksheets("Master")
    End Select

    With wsSrc

        LastRow = .Range("C" & Rows.Count).End(xlUp).Row

        If LastRow < 15 Then Exit Sub

        wsSrc.Range("A15").EntireRow.Insert xlShiftDown

        Set rngData = .Range("A15:X" & LastRow + 1)

    End With

    Set rngHeaders = rngData.Rows(1)

    NoCols = rngData.Columns.Count

    rngHeaders.Cells(1, 1).Value = "Field1"

    rngData.Cells(1, 1).AutoFill rngHeaders.Rows(1), xlFillDefault

    With wsDst

        LastRow = .Range("C" & Rows.Count).End(xlUp).Row + 1

        If LastRow = 14 Then LastRow = LastRow + 1

        Set rngDst = .Range("B" & LastRow)

    End With

    Set rngCrit = Worksheets("DoNotDelete").Range("A1:A2")

    rngCrit.Cells(1, 1).Value = "Field1"

    rngCrit.Cells(2, 1).Value = "Move to " & wsDst.Name

    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngCrit.Cells(1, 1).Offset(, 2), True

    rngHeaders.EntireRow.Delete



    LastRow = Worksheets("DoNotDelete").Range("C" & Rows.Count).End(xlUp).Row

    If LastRow = 1 Then
        Worksheets("DoNotDelete").Rows(1).Clear
    Else

        Set rngResult = Worksheets("DoNotDelete").Range("D2:W" & LastRow)

        rngResult.Interior.ColorIndex = xlNone

        For Each cl1 In rngResult.Columns(1).Cells
            For Each cl2 In rngData.Columns(2).Cells
                If cl2.Value = cl1.Value Then

                    cl2.Offset(, -1).Resize(, NoCols).ClearContents
                    cl2.Offset(, -1).Resize(, NoCols).Interior.ColorIndex = xlNone
                End If
            Next cl2
        Next cl1

        rngResult.Copy rngDst

        rngResult.Offset(, -3).Resize(, NoCols + 2).EntireColumn.Clear
    End If

    DataSortByID wsSrc
    DataSortByID wsDst

    Application.ScreenUpdating = True

    Application.CutCopyMode = False

End Sub

Open in new window

elwayisgodAuthor Commented:
When you double click in Column A, it's changing the colors and the value in column A to Move or Keep.  Where do I find these double click settings to change?  I don't see them in the VBA... Or is it not VBA and somewhere else?
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

kgerbChief EngineerCommented:
Look in the worksheet "Retrieval" code pane

Kyle
elwayisgodAuthor Commented:
ahhh....
sungenwangCommented:
Here's the updated workbook.
To copy the additional content, you need to change column W to column Z in TransferData() function
sew
EE-Template-NewV21-Stripped-Work.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
elwayisgodAuthor Commented:
Sweet. I got it.  I'm learning.  OK. Posting another question with a tweak needed :)
kgerbChief EngineerCommented:
If you're learning please don't study this particular code too hard.  It's bass ackwards!  There are better ways to do what this sub does.  A helper sheet and advanced filter?!?!  Really???

Kyle
elwayisgodAuthor Commented:
I'm not sudying per se... Hell, if you know a better way, I can send you my template that I just got done and have at it.  I'll award as many pts on multiple questions as you like.  I'm not a VBA person, I'm an Essbase person.  Let me know.
kgerbChief EngineerCommented:
I'll re-write it for ya.  I'll work on it tomorrow morning.  Gotta go home now.

Don't worry about another question.  I try not to get too wrapped up in the points thing.

Kyle
elwayisgodAuthor Commented:
OK.. I'm just taking over for another person.  But I still need it to work in meantime.  I got some other ideas too.  Try to use Dynamic Ranges if possible?  Right now I use 3000 rows starting at Row 15.  Maybe make it dynamic somehow would be cool.

Take care.
kgerbChief EngineerCommented:
Here you go.  That whole mess of code can be replaced with the code below.  Also I deleted row 14 from the "Retrieval" worksheet.  Hidden rows like that are a pain.  If it's absolutely necessary change the 14 to a 15 on line 15 of the code.

Also, can I assume from your name that you live in Denver?  I am a broncos fan myself.  Too bad about Tebow huh? :-).

Take care,
Kyle
Sub TransferData()
Dim wsFrom As Worksheet, wsTo As Worksheet, i As Long, vID As Variant, sAdd As String

'Define From and To worksheets
Select Case Application.Caller
    Case "Button 1"
        Set wsFrom = Sheets("Retrieval")
        Set wsTo = Sheets("Master")
    Case "Button 2"
        Set wsFrom = Sheets("Master")
        Set wsTo = Sheets("Retrieval")
End Select

'Copy rows containing "Move To Master" in col A to wsTo
For i = wsFrom.Cells(Rows.Count, "A").End(xlUp).Row To 14 Step -1
    If Left(Cells(i, "A"), 4) = "Move" Then
        With wsFrom.Rows(i)
            .Interior.ColorIndex = xlColorIndexNone
            .Cells(1).ClearContents
            .Copy wsTo.Rows(wsTo.Cells(Rows.Count, "B").End(xlUp).Offset(1).Row)
            .Delete
        End With
    End If
Next i

'Sort the data in wsTo with the newly added rows
Call DataSortByID(wsTo)
End Sub

Open in new window

Kyle
Q-27662788-RevA.xlsm
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.