Copy\Paste multiple criteria based rows to new sheet

**namz** · 05-26-2008, 02:47 AM

Originally Posted by rylo

Hi

See how this goes. There is some formatting that hasn't been done, but I'm after the data extract and formula correctness.

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("BigPond")
  OutSH.Cells.ClearContents
  
  'So from attached screenshot , say for an example macro shud filter rows that have
  '"BigPond" in coloum B ,"RG2" in column M & "INT" in column W and
  'i only want copy cells under column C,AK,AL,AM (in this order)
  'to my other excel sheet that is named "BigPond" and it should paste it starting from Row5. ??
  Sheets("Sites Data").Activate
  Range("A1").Select
  
  OutSH.Range("A1:C1").Value = Array("BU", "RG2", "Ext / Int")
  OutSH.Range("A2:C2").Value = Array("BigPond", ">0", "INT")
  
  OutSH.Range("A4:E4").Value = Array("Prefered Name", "RG2 Apps Shakeout - Verify App Deployment is complete", "RG2 Apps Shakeout - Verify users can login successfully", "RG2 Apps Shakeout - Verify users have correct roles", "Ext / Int")
  Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, criteriarange:=OutSH.Range("A1:B2"), copytorange:=OutSH.Range("A4:E4")
  
  With OutSH
    .Range("A4:E" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort order1:=xlDescending, key1:=.Range("E4"), header:=xlYes
    i = 5
    While .Cells(i, "E").Value = "INT"
      i = i + 1
    Wend
    breakrow = i
    .Cells(breakrow, "A").Resize(5, 1).EntireRow.Insert shift:=xlDown
    .Cells(breakrow, "A").Value = "INT Ttoal"
    .Cells(breakrow, "B").Formula = "=SUM(B5:B" & breakrow - 1 & ")/COUNTA($A5:$A" & breakrow - 1 & ")"
    .Cells(breakrow, "B").AutoFill Destination:=.Range(.Cells(breakrow, "B"), .Cells(breakrow, "E"))
    .Range("E4").Value = "Overall"
    .Range("E5").Formula = "=SUM(B5:D5)/3"
    .Range("D5").Copy
    .Range("E5").PasteSpecial (xlPasteFormats)
    .Range("E5").AutoFill Destination:=.Range("E5:E" & breakrow - 1)
    
    'formulas for EXT
    breakrow = breakrow + 5
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Cells(lastrow + 1, "A").Value = "EXT Total"
    .Cells(lastrow + 1, "B").Formula = "=sum(B" & breakrow & ":B" & lastrow & ")/counta($A" & breakrow & ":$A" & lastrow & ")"
    .Range("B" & lastrow + 1).Copy Destination:=.Range("B" & lastrow + 1 & ":E" & lastrow + 1)
    .Range("E5").Copy Destination:=.Range("E" & breakrow)
    .Range("E" & breakrow).AutoFill Destination:=.Range("E" & breakrow & ":E" & lastrow)
    lastrow = lastrow + 2
    .Range("A" & lastrow).Value = "Grand Total"
    
    intlastrow = .Range("A4").End(xlDown).Row - 1
    .Range("B" & lastrow).Formula = "=sum(B5:B" & intlastrow & ",B" & breakrow & ":B" & lastrow - 2 & ")/counta($A5:$A" & intlastrow & ",$A" & breakrow & ":$A" & lastrow - 2 & ")"
    .Range("B" & lastrow).AutoFill Destination:=.Range("B" & lastrow & ":E" & lastrow)
    
    .Range("B4:D4").Replace what:="RG2 Apps Shakeout - ", replacement:=""
  End With
End Sub

rylo

Hey mate , u r genius.....may b small adjustment should fix this...this is what i got..(see attached screenshot)....last 2 colums are meant to appear under "Externals"...i m sure this shud be a small correction of code...can u have a quick look & let me know..plzzz...

thnkz a ton..

**rylo** · 05-26-2008, 06:10 PM

Hi

Do you mean the last 2 rows not columns? I've put in a heading that totals the last 2 rows and calls them external. Do you want a heading to specify these, and perhaps remove the first 2 rows which are used in the extract.

rylo

**namz** · 05-26-2008, 08:07 PM

Originally Posted by rylo

Hi

Do you mean the last 2 rows not columns? I've put in a heading that totals the last 2 rows and calls them external. Do you want a heading to specify these, and perhaps remove the first 2 rows which are used in the extract.

rylo

Sorry didnt got what u explained..but Yes last 2 columns ..one for SURREY HILLS & BIGGERA WATERS are external sites so they should appear under Externals...can this be accomplished plzz..??

**rylo** · 05-26-2008, 10:07 PM

Hi

OK, try this.

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("BigPond")
  OutSH.Cells.Clear
  
  'So from attached screenshot , say for an example macro shud filter rows that have
  '"BigPond" in coloum B ,"RG2" in column M & "INT" in column W and
  'i only want copy cells under column C,AK,AL,AM (in this order)
  'to my other excel sheet that is named "BigPond" and it should paste it starting from Row5. ??
  Sheets("Sites Data").Activate
  Range("A1").Select
  
  OutSH.Range("A1:C1").Value = Array("BU", "RG2", "Ext / Int")
  OutSH.Range("A2:C2").Value = Array("BigPond", ">0", "INT")
  
  OutSH.Range("A4:E4").Value = Array("Prefered Name", "RG2 Apps Shakeout - Verify App Deployment is complete", "RG2 Apps Shakeout - Verify users can login successfully", "RG2 Apps Shakeout - Verify users have correct roles", "Ext / Int")
  Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, criteriarange:=OutSH.Range("A1:B2"), copytorange:=OutSH.Range("A4:E4")
  
  With OutSH
    .Range("A4:E" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort order1:=xlDescending, key1:=.Range("E4"), header:=xlYes
    i = 5
    While .Cells(i, "E").Value = "INT"
      i = i + 1
    Wend
    breakrow = i
    .Cells(breakrow, "A").Resize(5, 1).EntireRow.Insert shift:=xlDown
    .Cells(breakrow, "A").Value = "INT Ttoal"
    .Cells(breakrow + 3, "A").Value = "EXTERNAL"
    .Cells(breakrow, "B").Formula = "=SUM(B5:B" & breakrow - 1 & ")/COUNTA($A5:$A" & breakrow - 1 & ")"
    .Cells(breakrow, "B").AutoFill Destination:=.Range(.Cells(breakrow, "B"), .Cells(breakrow, "E"))
    .Cells(breakrow, "A").Resize(1, 5).Interior.ColorIndex = 15
    .Range("E4").Value = "Overall"
    .Range("E5").Formula = "=SUM(B5:D5)/3"
    .Range("D5").Copy
    .Range("E5").PasteSpecial (xlPasteFormats)
    .Range("E5").AutoFill Destination:=.Range("E5:E" & breakrow - 1)
    
    'formulas for EXT
    breakrow = breakrow + 5
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Cells(lastrow + 1, "A").Value = "EXT Total"
    .Cells(lastrow + 1, "B").Formula = "=sum(B" & breakrow & ":B" & lastrow & ")/counta($A" & breakrow & ":$A" & lastrow & ")"
    .Cells(lastrow + 1, "B").NumberFormat = "0%"
    .Range("B" & lastrow + 1).Copy Destination:=.Range("B" & lastrow + 1 & ":E" & lastrow + 1)
    .Range("A" & lastrow + 1).Resize(1, 5).Interior.ColorIndex = 15
    .Range("E5").Copy Destination:=.Range("E" & breakrow)
    .Range("E" & breakrow).AutoFill Destination:=.Range("E" & breakrow & ":E" & lastrow)
    lastrow = lastrow + 2
    .Range("A" & lastrow).Value = "Grand Total"
    
    intlastrow = .Range("A4").End(xlDown).Row - 1
    .Range("B" & lastrow).Formula = "=sum(B5:B" & intlastrow & ",B" & breakrow & ":B" & lastrow - 2 & ")/counta($A5:$A" & intlastrow & ",$A" & breakrow & ":$A" & lastrow - 2 & ")"
    .Range("B" & lastrow).NumberFormat = "0%"
    .Range("B" & lastrow).AutoFill Destination:=.Range("B" & lastrow & ":E" & lastrow)
    .Range("A" & lastrow).Resize(1, 5).Interior.ColorIndex = 44
    
    .Range("B4:D4").Replace what:="RG2 Apps Shakeout - ", replacement:=""
    
    .Range("A1:E2").ClearContents
    .Range("A2").Value = "INTERNAL"
    .Range("A2:E4").Interior.ColorIndex = 15
    .Rows("4:4").RowHeight = 46
    .Range("B4:E4").WrapText = True
  End With
End Sub

rylo

**namz** · 05-27-2008, 03:11 AM

Originally Posted by rylo

Hi

OK, try this.

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("BigPond")
  OutSH.Cells.Clear
  
  'So from attached screenshot , say for an example macro shud filter rows that have
  '"BigPond" in coloum B ,"RG2" in column M & "INT" in column W and
  'i only want copy cells under column C,AK,AL,AM (in this order)
  'to my other excel sheet that is named "BigPond" and it should paste it starting from Row5. ??
  Sheets("Sites Data").Activate
  Range("A1").Select
  
  OutSH.Range("A1:C1").Value = Array("BU", "RG2", "Ext / Int")
  OutSH.Range("A2:C2").Value = Array("BigPond", ">0", "INT")
  
  OutSH.Range("A4:E4").Value = Array("Prefered Name", "RG2 Apps Shakeout - Verify App Deployment is complete", "RG2 Apps Shakeout - Verify users can login successfully", "RG2 Apps Shakeout - Verify users have correct roles", "Ext / Int")
  Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, criteriarange:=OutSH.Range("A1:B2"), copytorange:=OutSH.Range("A4:E4")
  
  With OutSH
    .Range("A4:E" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort order1:=xlDescending, key1:=.Range("E4"), header:=xlYes
    i = 5
    While .Cells(i, "E").Value = "INT"
      i = i + 1
    Wend
    breakrow = i
    .Cells(breakrow, "A").Resize(5, 1).EntireRow.Insert shift:=xlDown
    .Cells(breakrow, "A").Value = "INT Ttoal"
    .Cells(breakrow + 3, "A").Value = "EXTERNAL"
    .Cells(breakrow, "B").Formula = "=SUM(B5:B" & breakrow - 1 & ")/COUNTA($A5:$A" & breakrow - 1 & ")"
    .Cells(breakrow, "B").AutoFill Destination:=.Range(.Cells(breakrow, "B"), .Cells(breakrow, "E"))
    .Cells(breakrow, "A").Resize(1, 5).Interior.ColorIndex = 15
    .Range("E4").Value = "Overall"
    .Range("E5").Formula = "=SUM(B5:D5)/3"
    .Range("D5").Copy
    .Range("E5").PasteSpecial (xlPasteFormats)
    .Range("E5").AutoFill Destination:=.Range("E5:E" & breakrow - 1)
    
    'formulas for EXT
    breakrow = breakrow + 5
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Cells(lastrow + 1, "A").Value = "EXT Total"
    .Cells(lastrow + 1, "B").Formula = "=sum(B" & breakrow & ":B" & lastrow & ")/counta($A" & breakrow & ":$A" & lastrow & ")"
    .Cells(lastrow + 1, "B").NumberFormat = "0%"
    .Range("B" & lastrow + 1).Copy Destination:=.Range("B" & lastrow + 1 & ":E" & lastrow + 1)
    .Range("A" & lastrow + 1).Resize(1, 5).Interior.ColorIndex = 15
    .Range("E5").Copy Destination:=.Range("E" & breakrow)
    .Range("E" & breakrow).AutoFill Destination:=.Range("E" & breakrow & ":E" & lastrow)
    lastrow = lastrow + 2
    .Range("A" & lastrow).Value = "Grand Total"
    
    intlastrow = .Range("A4").End(xlDown).Row - 1
    .Range("B" & lastrow).Formula = "=sum(B5:B" & intlastrow & ",B" & breakrow & ":B" & lastrow - 2 & ")/counta($A5:$A" & intlastrow & ",$A" & breakrow & ":$A" & lastrow - 2 & ")"
    .Range("B" & lastrow).NumberFormat = "0%"
    .Range("B" & lastrow).AutoFill Destination:=.Range("B" & lastrow & ":E" & lastrow)
    .Range("A" & lastrow).Resize(1, 5).Interior.ColorIndex = 44
    
    .Range("B4:D4").Replace what:="RG2 Apps Shakeout - ", replacement:=""
    
    .Range("A1:E2").ClearContents
    .Range("A2").Value = "INTERNAL"
    .Range("A2:E4").Interior.ColorIndex = 15
    .Rows("4:4").RowHeight = 46
    .Range("B4:E4").WrapText = True
  End With
End Sub

rylo

WOW..looks real good to me..all correct info is getting populated...now i've 2 questions for you...

1. can formatting be also fixed using some code in same macro , what i mean i have attached sceernshot "BP" that i got when i ran this macro but i would like formatting to be like shown in screenshot "BP(formated)" . Not major things to fix....."Internals" section looks just perfect..External sections needs to be fixed... I guess if we use "paste - values" instead of simple that should also assist me in future.

2. 2nd thing, now this macro was for 1 client "BigPond" , i have around 2000 rows of colum in my complete extract and it has 12 other clients other than "BigPond" . Can you plz inform me if this same maco code can be used for other clients ? If yes ..than when i copy this code what things should i be change so that i get same result for other Clients.

Thanks buddy....u seems to have solved lot of my issues ...it has been awesome so far...thank again in adv...

Cheers!!

**namz** · 05-27-2008, 03:12 AM

Originally Posted by namz

WOW..looks real good to me..all correct info is getting populated...now i've 2 questions for you...

1. can formatting be also fixed using some code in same macro , what i mean i have attached sceernshot "BP" that i got when i ran this macro but i would like formatting to be like shown in screenshot "BP(formated)" . Not major things to fix....."Internals" section looks just perfect..External sections needs to be fixed... I guess if we use "paste - values" instead of simple that should also assist me in future.

2. 2nd thing, now this macro was for 1 client "BigPond" , i have around 2000 rows of colum in my complete extract and it has 12 other clients other than "BigPond" . Can you plz inform me if this same maco code can be used for other clients ? If yes ..than when i copy this code what things should i be change so that i get same result for other Clients.

Thanks buddy....u seems to have solved lot of my issues ...it has been awesome so far...thank again in adv...

Cheers!!

Screenshots attached..

**rylo** · 05-27-2008, 07:48 PM

Hi

1) I think I have the formatting right...

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("BigPond")
  OutSH.Cells.Clear
  
  'So from attached screenshot , say for an example macro shud filter rows that have
  '"BigPond" in coloum B ,"RG2" in column M & "INT" in column W and
  'i only want copy cells under column C,AK,AL,AM (in this order)
  'to my other excel sheet that is named "BigPond" and it should paste it starting from Row5. ??
  Sheets("Sites Data").Activate
  Range("A1").Select
  
  OutSH.Range("A1:C1").Value = Array("BU", "RG2", "Ext / Int")
  OutSH.Range("A2:C2").Value = Array("BigPond", ">0", "INT")
  
  OutSH.Range("A4:E4").Value = Array("Prefered Name", "RG2 Apps Shakeout - Verify App Deployment is complete", "RG2 Apps Shakeout - Verify users can login successfully", "RG2 Apps Shakeout - Verify users have correct roles", "Ext / Int")
  Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, criteriarange:=OutSH.Range("A1:B2"), copytorange:=OutSH.Range("A4:E4")
  
  With OutSH
    .Range("A4:E" & .Cells(Rows.Count, 1).End(xlUp).Row).Sort order1:=xlDescending, key1:=.Range("E4"), header:=xlYes
    i = 5
    While .Cells(i, "E").Value = "INT"
      i = i + 1
    Wend
    breakrow = i
    .Cells(breakrow, "A").Resize(5, 1).EntireRow.Insert shift:=xlDown
    .Cells(breakrow, "A").Value = "INT Total"
    .Cells(breakrow, "A").Font.Bold = True
    .Cells(breakrow + 2, "A").Value = "EXTERNAL"
    .Cells(breakrow, "B").Formula = "=SUM(B5:B" & breakrow - 1 & ")/COUNTA($A5:$A" & breakrow - 1 & ")"
    .Cells(breakrow, "B").AutoFill Destination:=.Range(.Cells(breakrow, "B"), .Cells(breakrow, "E"))
    .Cells(breakrow, "A").Resize(1, 5).Interior.ColorIndex = 15
    .Range("E4").Value = "Overall"
    .Range("E5").Formula = "=SUM(B5:D5)/3"
    .Range("D5").Copy
    .Range("E5").PasteSpecial (xlPasteFormats)
    .Range("E5").AutoFill Destination:=.Range("E5:E" & breakrow - 1)
    
    'formulas for EXT
    breakrow = breakrow + 5
    lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Cells(lastrow + 1, "A").Value = "EXT Total"
    .Cells(lastrow + 1, "A").Font.Bold = True
    .Cells(lastrow + 1, "B").Formula = "=sum(B" & breakrow & ":B" & lastrow & ")/counta($A" & breakrow & ":$A" & lastrow & ")"
    .Cells(lastrow + 1, "B").NumberFormat = "0%"
    .Range("B" & lastrow + 1).Copy Destination:=.Range("B" & lastrow + 1 & ":E" & lastrow + 1)
    .Range("A" & lastrow + 1).Resize(1, 5).Interior.ColorIndex = 15
    .Range("E5").Copy Destination:=.Range("E" & breakrow)
    .Range("E" & breakrow).AutoFill Destination:=.Range("E" & breakrow & ":E" & lastrow)
    lastrow = lastrow + 2
    .Range("A" & lastrow).Value = "Grand Total"
    
    .Range("A" & lastrow).Font.Underline = xlUnderlineStyleDouble
    .Range("A" & lastrow).Font.Bold = True
    intlastrow = .Range("A4").End(xlDown).Row - 1
    .Range("B" & lastrow).Formula = "=sum(B5:B" & intlastrow & ",B" & breakrow & ":B" & lastrow - 2 & ")/counta($A5:$A" & intlastrow & ",$A" & breakrow & ":$A" & lastrow - 2 & ")"
    .Range("B" & lastrow).NumberFormat = "0%"
    .Range("B" & lastrow).AutoFill Destination:=.Range("B" & lastrow & ":E" & lastrow)
    .Range("A" & lastrow).Resize(1, 5).Interior.ColorIndex = 44
    
    .Range("B4:D4").Replace what:="RG2 Apps Shakeout - ", replacement:=""
    '.Range("B" & breakrow - 1).Resize(1, 4).Value = .Range("B4:E4").Value
    .Range("A1:E2").ClearContents
    .Range("A2").Value = "INTERNAL"
    .Range("A2:E4").Interior.ColorIndex = 15
    .Rows("4:4").RowHeight = 46
    .Range("B4:E4").WrapText = True
    .Range("B4:E4").Copy Destination:=.Cells(breakrow - 1, "B")
    .Range("A" & intlastrow + 1 & ":E" & breakrow - 1).Interior.ColorIndex = 15
    
    .Range("B:E").HorizontalAlignment = xlCenter
  End With
End Sub

2) Yep, just change the value of "Bigpond" in the code to whatever you want to extract.

rylo

Copy\Paste multiple criteria based rows to new sheet

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions