Check out some similar questions!

lyss · Sep 27, 2009, 06:31 PM

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

JBeaucaire · Sep 27, 2009, 11:40 PM

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.

lyss · Sep 28, 2009, 05:57 AM

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!

JBeaucaire · Sep 28, 2009, 07:25 AM

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.

lyss · Sep 28, 2009, 07:38 AM

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!

JBeaucaire · Sep 28, 2009, 12:39 PM

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.

lyss · Sep 28, 2009, 12:53 PM

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!!

JBeaucaire · Sep 28, 2009, 03:16 PM

Originally Posted by 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!!!!

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.

lyss · Sep 28, 2009, 03:31 PM

Thanks again and sorry for using so much of your time! Here are the 2 files I'm using and getting that error.
Lil

JBeaucaire · Sep 28, 2009, 06:12 PM

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.

lyss · Sep 28, 2009, 06:25 PM

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

JBeaucaire · Sep 28, 2009, 08:27 PM

Originally Posted by 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

Digital Hug

(**whistles innocently**)