PDA

View Full Version : Insert Copied does not work when selecting Visible Cells Only



raykayplay
12-11-2014, 01:36 AM
Hello All,

I am writing a macro while i:

1- Filter on a certain criteria - ok
2- Select all visible cells within the range - ok
3- Go to another sheet - ok
4- Go to a named range - ok
4- Insert Copied. (only works if i do activesheet.paste)

I need the insert copied rather than simple pasting the data as i need the rows coming after where i paste not to be replaced.

I am quiet certain it is the visible cells criteria is the one messing the macro as when i select a series of rows that are in a sequence it works fine.

I am happy to provide a copy of the sheet however after 12 hours from now as i am home and the template is at work.

Thank you in advance for any help.

Regards

AreKay

GTO
12-11-2014, 04:41 AM
Greetings and Welcome to vbax!

You will meet some great folks here :-) who are happy to help. As to your issue - yep - post a workbook. I say this as one of the greatest things about vbax (paling by far to member input of course), is being able to download a workbook, rather than each possible 'answerer' recreating (with rather fishy accuracy) what you are looking at.

Mark

raykayplay
12-11-2014, 05:23 PM
Greetings and Welcome to vbax!

You will meet some great folks here :-) who are happy to help. As to your issue - yep - post a workbook. I say this as one of the greatest things about vbax (paling by far to member input of course), is being able to download a workbook, rather than each possible 'answerer' recreating (with rather fishy accuracy) what you are looking at.

Mark

Thank you for your message. I have been trying to see if i can upload the attachment but due to internal clearance policies i am unable to send the attachment.

The core of it is as follows:
Sub Macro1()


ActiveSheet.Range("$A$3:$G$8").AutoFilter Field:=7, Criteria1:="04"
On Error GoTo ErrorHandler
ErrorHandler:
GoTo Movement2
Range("A4:G8").Select
Selection.Copy
ActiveWorkbook.Sheets("Destination").Activate
colvaradd = Application.WorksheetFunction.VLookup(colvar, Range("Rami"), 2, False)
Application.Goto Range("Move0")
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Movement2:
ActiveWorkbook.Sheets("Source").Activate
ActiveSheet.Range("$A$3:$G$8").AutoFilter Field:=7, Criteria1:="01"
Range("A3").Activate
ActiveCell.Offset(1, 0).Range("A1").Select
Range("A4:G8").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
ActiveWorkbook.Sheets("Destination").Activate
Application.Goto Range("Move1")
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Movement3:
ActiveWorkbook.Sheets("Source").Activate
ActiveSheet.Range("$A$3:$G$8").AutoFilter Field:=7, Criteria1:="02"
Range("A3").Activate
ActiveCell.Offset(1, 0).Range("A1").Select
Range("A4:G8").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
ActiveWorkbook.Sheets("Destination").Activate
Application.Goto Range("move2")
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

End Sub




It starts in the activesheet, filters the range A5:BC2004 based on criteria as per above.
Selection is copied.
Go to a named range which is move1.
It goes down the list and offsets an additional row.
When i insert copied is where is is falling over.

If the data i had selected originaly were on consecutive rows, it works. However when the data being copied are not on consecutive rows it on shifts one cell down.

I have attached a sample.

Thank you all in advance for your help.

GTO
12-12-2014, 12:02 AM
Greetings,

This isn't much, but maybe a start?


Option Explicit

Public Sub example01()
Const DESTNAME = "Destination"
Const SOURCENAME = "Source"

Dim wksSource As Worksheet
Dim wksDest As Worksheet
Dim rngFound As Range
Dim rngData As Range
Dim lRowCount As Long
Dim n As Long

'// Ensure both sheets exist. //
If Not (SheetExists(DESTNAME) And SheetExists(SOURCENAME)) Then
MsgBox "error missing sheet(s)...", vbCritical, vbNullString
Exit Sub
End If

Set wksDest = ThisWorkbook.Worksheets(DESTNAME)
Set wksSource = ThisWorkbook.Worksheets(SOURCENAME)

With wksSource
'// Find any type data in the last row w/data in columns of insterest. If this //
'// fails, bail. //
Set rngFound = RangeFound(.Range(.Range("A4"), .Cells(.Rows.Count, "G")))
If rngFound Is Nothing Then
MsgBox "No data...", vbInformation, vbNullString
Exit Sub
End If
'// Else, Set a reference to the range of interest (including the header row for //
'// the moment). //
Set rngData = .Range(.Range("A3"), .Cells(rngFound.Row, "G"))
End With

With rngData

.Parent.AutoFilterMode = False
.AutoFilter Field:=7, Criteria1:="02"

'// See how many visible rows there are, so we know how many rows to insert. Note //
'// that we ditched the header row since we just want the data. //
For n = 1 To .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Areas.Count
lRowCount = _
lRowCount + _
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Areas(n).Rows.Count
Next

'// You'll need something better (dynamic) than this to build the address in some //
'// manner, but I'm not quite following as well as I should be. //
wksDest.Range("5:" & CStr(5 + (lRowCount - 1))).Insert xlDown

'// Copy the visible cells to the created rows. //
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy wksDest.Range("A5")

.Parent.AutoFilterMode = False

End With

End Sub

Public Function SheetExists(ByVal ShName As String, Optional ByVal WB As Workbook) As Boolean
If WB Is Nothing Then Set WB = ThisWorkbook
On Error Resume Next
SheetExists = (WB.Worksheets(ShName).Name = ShName)
End Function

Public Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange.Cells(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

If the results look anything like what you are going after, maybe we could used the named range cells on the destination sheet to figure out where we insert each time?

Mark

raykayplay
12-12-2014, 01:05 AM
[QUOTE=GTO;318483]Greetings,

This isn't much, but maybe a start?

[code]Option Explicit

Public Sub example01()
Const DESTNAME = "Destination"
Const SOURCENAME = "Source"

-----

Mark,

You most certainly have gone the extra mile.
Sincerest gratitude.

Am afraid that code you have provided is far too complicated to keep within current work template.

Reason that is a concern is basically at work we can not leave this as a legacy document in case i leave and someone has to take control.

I have looked further into the solution to adapt it into a simple macro that i have quoted earlier, and it seems that the only quick solid fix around it is to copy the visible range paste it into another sheet Then copy the data from that sheet (now no gaps between rows), then insert them into the destination,

It is a long one am sure, but in case i do leave, someone can easily trace where it went wrong. This is an issue because i work within the Cost control department and any replacement might not have good understanding of VBA.

In any case, i would like to extend my gratitude yet again and if there is anything i can do to repay the favor which was great effort on your behalf, please do let me know.

Have a good weekend mate.

cheers