Solved

VBA - Excel 2007 - Modify current code

Posted on 2012-04-04
12
345 Views
Last Modified: 2012-04-05
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
0
Comment
Question by:elwayisgod
  • 6
  • 5
12 Comments
 
LVL 12

Expert Comment

by:kgerb
ID: 37808125
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
0
 

Author Comment

by:elwayisgod
ID: 37808175
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

0
 

Author Comment

by:elwayisgod
ID: 37808202
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?
0
 
LVL 12

Expert Comment

by:kgerb
ID: 37808210
Look in the worksheet "Retrieval" code pane

Kyle
0
 

Author Comment

by:elwayisgod
ID: 37808274
ahhh....
0
 
LVL 14

Accepted Solution

by:
sungenwang earned 500 total points
ID: 37808312
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
0
How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

 

Author Closing Comment

by:elwayisgod
ID: 37808374
Sweet. I got it.  I'm learning.  OK. Posting another question with a tweak needed :)
0
 
LVL 12

Expert Comment

by:kgerb
ID: 37808395
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
0
 

Author Comment

by:elwayisgod
ID: 37808409
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.
0
 
LVL 12

Expert Comment

by:kgerb
ID: 37808437
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
0
 

Author Comment

by:elwayisgod
ID: 37808453
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.
0
 
LVL 12

Expert Comment

by:kgerb
ID: 37811584
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
0

Featured Post

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now