Ask Me Help Desk

Ask Me Help Desk (https://www.askmehelpdesk.com/forum.php)
-   Spreadsheets (https://www.askmehelpdesk.com/forumdisplay.php?f=395)
-   -   Stuck on Relational Cell Macro (https://www.askmehelpdesk.com/showthread.php?t=400455)

  • Sep 27, 2009, 06:31 PM
    lyss
    Stuck on Relational Cell Macro
    Hello - needing some help on a Excel2007 macro I'm trying to create. I'm not an expert at it so may be a simple answer (hopeflly)... In this macro, I'm trying to copy and highlight a range of cells by using my left/right arrows incombination with shift and ctrl but since the data can be various sizes, I need to ensure it is not pointing to a specific cell location. An example of what I'm trying to higlight:

    Column A | Column B;
    Row 1 data Sum formula (to copy)
    Row 2... data
    Row 50 (as an exammpl)

    1. Have a sum I'm trying to copy from Column B:1
    2. Wanted to do a macro that captured:
    (a) Go Left one cell from B:1 (to A:1)
    (b) Then do CTRL+Down to go to the last entry row populated
    (c) Go Right one cell (to go back to column B)
    (d) Then do SHIFT+CTRL+Up to highlight All of Column B
    (e) Then go SHIFT+DOWN 1 cell to B:2 so B:50 to B:2 is all highlighted to paste

    Now that I'm using relative and non-relative on the "Stop Macro" box, it's not capturing the last (e) for some reason and the macro cannot paste since it is still capturing the cell I'm copying from.

    Here is the actual macro:
    Selection.Copy
    ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveCell.Offset(-82, 0).Range("A2:A83").Select
    ActiveCell.Activate
    ActiveSheet.Paste

    Can someone help?

    Many thanks!
    Lil
  • Sep 27, 2009, 11:40 PM
    JBeaucaire

    Click on GO ADVANCED and use the paperclip icon to upload a sample workbook.

    In the sample workbook, put a BEFORE and an AFTER sheet so I can see what the beginning and ending state of the sheet would be.

    If one sample BEFORE/AFTER does not adequately demonstrate all the hurdles that need to be over come (like differences in lengths of data and such), then perhaps a 2 or 3 BEFORE/AFTER samples.
  • Sep 28, 2009, 05:57 AM
    lyss
    2 Attachment(s)

    Ok thanks! Here it is up to where I'm getting stuck - the data - just copy and paste to make the data larger to see that it's not capturing when more data is added. Thanks so much for taking a look at this!
  • Sep 28, 2009, 07:25 AM
    JBeaucaire

    Here are is a tweaked version of your macro. Read through it. I removed a lot of unnecessary "selecting", and I've introduced a variable for storing the "last row position" so you can simply use that knowledge to insert the formula directly into the full range of cells in column D instead of having to insert it THEN copy it.

    Code:
    Sub CreateReport()
    '
    ' CreateReport Macro
    ' Macro recorded 9/27/2009 by Lil
    ' Edited by JBeaucaire  9/28/2009
    ' Keyboard Shortcut: Ctrl+w
    '
    Dim LR As Long    'variable for storing last row position of data

        Sheets("Sheet1").Activate
        Range("A2").Select
        ActiveSheet.Paste
        Range("A1").Select
        Application.CutCopyMode = False
        Sheets("Sheet1").Copy After:=Sheets(2)
        Sheets("Sheet1 (2)").Copy After:=Sheets(3)
        Sheets("Sheet1").Name = "DATA"
        Sheets("Sheet1 (2)").Activate
        Range("A1").Select
        ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
            "'Sheet1 (2)'!R1C1:R22C6").CreatePivotTable TableDestination:="", TableName _
            :="PivotTable7", DefaultVersion:=xlPivotTableVersion10
        ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
        ActiveSheet.Cells(3, 1).Select
        With ActiveSheet.PivotTables("PivotTable7").PivotFields("City")
            .Orientation = xlRowField
            .Position = 1
        End With
        ActiveSheet.PivotTables("PivotTable7").AddDataField ActiveSheet.PivotTables( _
            "PivotTable7").PivotFields("Total" & Chr(10) & "Away"), "Sum of Total" & Chr(10) & "Away", xlSum
        Sheets("Sheet1").Name = "CityTotals"
        Sheets("Sheet1 (2)").Activate
        Range("D1:F1").EntireColumn.Delete xlShiftToLeft

        LR = Range("A" & Rows.Count).End(xlUp).Row
        Range("D2:D" & LR).FormulaR1C1 = "=AND(EXACT(RC[-3],R[1]C[-3]),EXACT(RC[-2],R[1]C[-2]))"
        Range("D2:D" & LR).Value = Columns("D:D" & LR).Value
        Range("A1:D1").AutoFilter
        Range("A1:D1").AutoFilter Field:=4, Criteria1:="TRUE"
        Range("A2:D" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete xlShiftUp
        ActiveSheet.AutoFilterMode = False
        Columns("D:D").ClearContents
        Range("A1").Select
        ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
            "'Sheet1 (2)'!R1C1:R14C3").CreatePivotTable TableDestination:="", TableName _
            :="PivotTable8", DefaultVersion:=xlPivotTableVersion10
        ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
        ActiveSheet.Cells(3, 1).Select
        With ActiveSheet.PivotTables("PivotTable8").PivotFields("City")
            .Orientation = xlRowField
            .Position = 1
        End With
        ActiveSheet.PivotTables("PivotTable8").AddDataField ActiveSheet.PivotTables( _
            "PivotTable8").PivotFields("Total" & Chr(10) & "Employees"), "Sum of Total" & Chr(10) & "Employees", xlSum
            ActiveSheet.PivotTables("PivotTable8").PivotSelect "", xlDataAndLabel, True
        Selection.Copy
        Sheets("CityTotals").Activate
        Range("C3").Select
        ActiveSheet.Paste
        Range("A1").Select
        Columns("C:C").ColumnWidth = 14.14
        Sheets("Sheet2").Name = "TTLEmpByCity"
        Application.CutCopyMode = False
        Sheets("Sheet1 (3)").Select
        ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
            "'Sheet1 (3)'!R1C1:R22C6").CreatePivotTable TableDestination:="", TableName _
            :="PivotTable11", DefaultVersion:=xlPivotTableVersion10
        ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
        ActiveSheet.Cells(3, 1).Select
        With ActiveSheet.PivotTables("PivotTable11").PivotFields("Department")
            .Orientation = xlRowField
            .Position = 1
        End With
        With ActiveSheet.PivotTables("PivotTable11").PivotFields("Division")
            .Orientation = xlRowField
            .Position = 1
        End With
        Columns("A:A").ColumnWidth = 9
        ActiveSheet.PivotTables("PivotTable11").AddDataField ActiveSheet.PivotTables( _
            "PivotTable11").PivotFields("Total" & Chr(10) & "Away"), "Sum of Total" & Chr(10) & "Away", xlSum
        ActiveSheet.PivotTables("PivotTable11").PivotSelect "", xlDataAndLabel, True
        ActiveSheet.PivotTables("PivotTable11").Format xlReport2
        Sheets("Sheet3").Name = "DeptTotals"
        Range("A1").Select
        Sheets("Sheet1 (3)").Activate
       
        LR = Range("A" & Rows.Count).End(xlUp).Row
        Range("D2:D" & LR).FormulaR1C1 = "=AND(EXACT(RC[-3],R[1]C[-3]),EXACT(RC[-2],R[1]C[-2]))"
        Range("D2:D" & LR).Value = Range("D2:D" & LR).Value
        Range("A1:D1").AutoFilter
        Range("A1:D1").AutoFilter Field:=4, Criteria1:="TRUE"
        Range("A2:D" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete xlShiftUp
        ActiveSheet.AutoFilterMode = False
        Columns("D:D").clearcontest
        Range("A1").Select
           
        ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
            "'Sheet1 (3)'!R1C1:R14C5").CreatePivotTable TableDestination:="", TableName _
            :="PivotTable16", DefaultVersion:=xlPivotTableVersion10
        ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
        ActiveSheet.Cells(3, 1).Select
        With ActiveSheet.PivotTables("PivotTable16").PivotFields("Department")
            .Orientation = xlRowField
            .Position = 1
        End With
        With ActiveSheet.PivotTables("PivotTable16").PivotFields("Division")
            .Orientation = xlRowField
            .Position = 1
        End With
        ActiveSheet.PivotTables("PivotTable16").AddDataField ActiveSheet.PivotTables( _
            "PivotTable16").PivotFields("Total" & Chr(10) & "Employees"), "Sum of Total" & Chr(10) & "Employees", xlSum
        Range("A1").Select
        Columns("A:A").ColumnWidth = 12.43
        ActiveSheet.PivotTables("PivotTable16").PivotSelect "", xlDataAndLabel, True
        ActiveSheet.PivotTables("PivotTable16").Format xlReport2
        Selection.Copy
        Sheets("DeptTotals").Activate
        Range("E3").Select
        ActiveSheet.Paste
        Columns("F:F").ColumnWidth = 23
        Columns("F:F").ColumnWidth = 29.14
        Columns("D:D").ColumnWidth = 1.86
        Range("A1").Select
        Sheets("DeptTotals").Select
        Application.CutCopyMode = False
        Sheets("DeptTotals").Move Before:=Sheets(4)
            With ActiveSheet.PageSetup
            .PrintTitleRows = ""
            .PrintTitleColumns = ""
        End With
        ActiveSheet.PageSetup.PrintArea = ""
        With ActiveSheet.PageSetup
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.295275590551181)
            .RightMargin = Application.InchesToPoints(0.295275590551181)
            .TopMargin = Application.InchesToPoints(0.295275590551181)
            .BottomMargin = Application.InchesToPoints(0.295275590551181)
            .HeaderMargin = Application.InchesToPoints(0.511811023622047)
            .FooterMargin = Application.InchesToPoints(0.511811023622047)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .PrintQuality = -3
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlPortrait
            .Draft = False
            .PaperSize = xlPaperLetter
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = 100
            .PrintErrors = xlPrintErrorsDisplayed
        End With
        Range("A:A,E:E").Select
        Range("E1").Activate
        Selection.ColumnWidth = 6
        Range("A1").Select
    End Sub
    I also used that same "last row" variable to manipulate the data with the autofilter directly as well.
  • Sep 28, 2009, 07:38 AM
    lyss

    Hey thanks SOOOO much for looking at it and the "last row" variable! That's great! I think I'll have to disect it a bit more to learn it (I'm still very new to this). I tried the new macro but still had an error on : "Range("D2:D" & LR).Value = Columns("D:D" & LR).Value" At least it's getting close. Thanks SO much again - nice to have a place to ask!
  • Sep 28, 2009, 12:39 PM
    JBeaucaire

    That's a typo on my part, it's supposed to be the same on each end of the line of code:
    Code:
    Range("D2:D" & LR).Value = Range("D2:D" & LR).Value
    Sorry about that.
  • Sep 28, 2009, 12:53 PM
    lyss

    Awe nooo problem - just appreciate the assist tremendously... Got past that one but came across another: Range("A2:D" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Dele te xlShiftUp

    Sorry!!
  • Sep 28, 2009, 03:16 PM
    JBeaucaire
    Quote:
    Originally Posted by lyss View Post
    Awe nooo problem - just appreciate the assist tremendously... Got past that one but came across another: Range("A2:D" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Dele te xlShiftUp

    Sorry!!!!
    How many rows are still visible on the sheet at that point? Any? If not, I can see how that might cause an error.

    If you post up the actual sheet you're working with the macro installed, I can review it directly.
  • Sep 28, 2009, 03:31 PM
    lyss
    2 Attachment(s)
    Thanks again and sorry for using so much of your time! Here are the 2 files I'm using and getting that error.
    Lil
  • Sep 28, 2009, 06:12 PM
    JBeaucaire

    Like I said, you're inserting a formula that gives TRUE/FALSE answers and then filtering for TRUE. If there are NO TRUE answers, there is nothing to delete.

    So, if that is going to happen with regularity, change that one line of code to:
    Code:
    If Range("A" & Rows.Count).End(xlUp).Row > 1 Then Range("A2:D" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Delete xlShiftUp
    There's also a typo a little ways down from the second place that line of code is, fix this, too:
    Code:
    Columns("D:D").ClearContents
    Your macro seems to work great up to the PivotTable16 section then stops on me. You'll have to work that out.
  • Sep 28, 2009, 06:25 PM
    lyss

    That worked GREAT!! FANTASTIC!! I can go from there to fix the pivot table. Wow!! Thanks SOOOOOO much! Really really appreciate all your help! WOOHOO! You don't know HOW much this has been BUGGING me! Thanks a million! If you were here I'd give you a BIG HUG! LOL :D
    Lil
  • Sep 28, 2009, 08:27 PM
    JBeaucaire
    Quote:
    Originally Posted by lyss View Post
    That worked GREAT!!! FANTASTIC!!! I can go from there to fix the pivot table. Wow!!! Thanks SOOOOOO much! Really really appreciate all your help!! WOOHOO! You don't know HOW much this has been BUGGING me! Thanks a million! If you were here I'd give you a BIG HUG!! LOL :D
    Lil
    Digital Hug

    (**whistles innocently**)

    • All times are GMT -7. The time now is 05:10 AM.