Solved

VBA - Excel 2007 - Modify current code

Posted on 2012-04-04
12
364 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
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 
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
 

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

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

777 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