PDA

View Full Version : Stuck on Relational Cell Macro


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.


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:=xlDatab ase, 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.Dele te xlShiftUp
ActiveSheet.AutoFilterMode = False
Columns("D:D").ClearContents
Range("A1").Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatab ase, 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:=xlDatab ase, 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.Dele te xlShiftUp
ActiveSheet.AutoFilterMode = False
Columns("D:D").clearcontest
Range("A1").Select

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatab ase, 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:

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

If Range("A" & Rows.Count).End(xlUp).Row > 1 Then Range("A2:D" & LR).SpecialCells(xlCellTypeVisible).EntireRow.Dele te xlShiftUp

There's also a typo a little ways down from the second place that line of code is, fix this, too:

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
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 (http://www.originalroadhousegrill.com/gift.html)

(**whistles innocently**)