Range resizing itself

[Gary Orr]

I think that my last attempt to post this blew up on me, so I hope that this
doesn't double up...

I have a fairly simple copy/paste VBA routine (Excel 2007) that works if the
range to paste into falls within the UsedRange of the worksheet, but which
resizes itself if not.

Here's the scenario:
Source (copy range): (A2:K2)

Destination Worksheet "UsedRange": (A110)

If Paste Range is: (F22) Success!!!

If Paste Range is: (G2:Q2) Needs User Interaction due to Prompt:
"Contents of Clipboard do not match selected... Paste... Anyway?"

I have checked all of the things (protected cells, etc) that I can think of,
and have even tried to expand the UsedRange by Inserting text into a cell
outside of the UsedRange (which it lets me do without any trouble and shows
an updated value when queried).

If I check the range to be pasted into via the debugger it shows the correct
number of columns, but if I view the selected range in Excel it stops at the
"previous" UsedRange.
Is there a setting that I can toggle to get past this?

I'm at a loss. Any assistance would be appreciated.

Gary

 

[Tim Williams]

Would be simpler to debug if you posted your actual code...

Tim

 

[Gary Orr]

Right now the code is so bloated from the half dozen different attempts...
and I believe that the problem is the file, not the code, but...


Sub import()

Dim xlsApp As Excel.Application
Set xlsApp = GetObject(, "Excel.Application")

Dim xlsWb As Excel.Workbook
Set xlsWb = xlsApp.ActiveWorkbook
Dim xlsWs As Excel.Worksheet
Set xlsWs = xlsWb.ActiveSheet

Dim xlsCols As Long
Dim xlsRows As Long
xlsCols = LastColumn(xlsWs)
xlsRows = LastRow(xlsWs)
Debug.Print "Last Func -> Cols: " & xlsCols & "; Rows: " & xlsRows
xlsCols = xlsWs.UsedRange.Columns.Count
xlsRows = xlsWs.UsedRange.Rows.Count
Debug.Print "Range -> Cols: " & xlsCols & "; Rows: " & xlsRows
Dim NextxlsRow As Long
NextxlsRow = xlsRows + 1

Dim xlsGUIDRow As Long
Dim xlsGUIDCol As Long
Dim xlsGUID As Range
Set xlsGUID = FindGUID(xlsWs)
xlsGUIDCol = xlsGUID.Column
xlsGUIDRow = xlsGUID.Row

Dim NewApp As Excel.Application
Set NewApp = CreateObject("Excel.Application")

Dim SourceFileName As String
Dim Filedia As FileDialog
Set Filedia = Application.FileDialog(msoFileDialogOpen)
Filedia.Show
SourceFileName = Filedia.SelectedItems.Item(1)

Dim SourceWb As Workbook
Set SourceWb = NewApp.Workbooks.Open(SourceFileName, , True)

Dim SourceWs As Worksheet
Set SourceWs = SourceWb.ActiveSheet

Dim SrcCols As Long
Dim SrcRows As Long
SrcCols = LastColumn(SourceWs)
SrcRows = LastRow(SourceWs)
Debug.Print "Last Func -> Cols: " & SrcCols & "; Rows: " & SrcRows
SrcCols = SourceWs.UsedRange.Columns.Count
SrcRows = SourceWs.UsedRange.Rows.Count
Debug.Print "Range -> Cols: " & SrcCols & "; Rows: " & SrcRows

Dim SourceGUIDRow As Long
Dim SourceGUIDCol As Long
Dim SourceGUID As Range
Set SourceGUID = FindGUID(SourceWs)
SourceGUIDCol = SourceGUID.Column
SourceGUIDRow = SourceGUID.Row

Dim ThisRowNumb As Long
ThisRowNumb = SourceGUIDRow
Dim SourceColCnt As Long
Dim xlsColCnt As Long
SourceColCnt = SourceGUIDCol + SrcCols
xlsColCnt = xlsGUIDCol + SrcCols

If xlsColCnt > xlsCols Then
xlsWs.Range(xlsWs.Cells(NextxlsRow, xlsColCnt),
xlsWs.Cells(NextxlsRow, xlsColCnt)).Value = "NewCol"
xlsCols = xlsWs.UsedRange.Columns.Count
End If

Dim CopyRange As Range
Dim PasteRange As Range

Debug.Print "Searching... "

While ThisRowNumb <= SrcRows
If ThisRowNumb Like "*00" Then
Debug.Print ThisRowNumb & " Processed"
End If

If xlsWs.Cells.Find(SourceWs.Cells(ThisRowNumb, SourceGUIDCol).Text,
MatchCase:=vbFalse) Is Nothing Then
Debug.Print "Copying... " & SourceWs.Cells(ThisRowNumb,
SourceGUIDCol).Text

Set CopyRange = SourceWs.Range(SourceWs.Cells(ThisRowNumb,
SourceGUIDCol), SourceWs.Cells(ThisRowNumb, SourceColCnt))
CopyRange.Copy


Set PasteRange = xlsWs.Range(xlsWs.Cells(NextxlsRow,
xlsGUIDCol), xlsWs.Cells(NextxlsRow, xlsColCnt))
Debug.Print "Columns: " & CopyRange.Columns.Count & " -> " &
PasteRange.Columns.Count
PasteRange.Select
PasteRange.PasteSpecial Paste:=xlPasteValues

Debug.Print "Columns: " & PasteRange.Columns.Count

NextxlsRow = NextxlsRow + 1
End If
ThisRowNumb = ThisRowNumb + 1
Wend

SourceWb.Close (False)
NewApp.Quit
Debug.Print "Done."
End Sub



Private Function FindGUID(ByRef ws As Worksheet) As Range

Dim WsCols As Long
Dim WsRows As Long
' WsCols = ws.UsedRange.Columns.Count
' WsRows = ws.UsedRange.Rows.Count
WsCols = LastColumn(ws)
WsRows = LastRow(ws)

Dim ColNumb As Long
Dim RowNumb As Long
RowNumb = 1

While RowNumb <= WsRows
ColNumb = 1
While ColNumb <= WsCols
' If UCase(ws.Cells(ColNumb, RowNumb).Text) Like "*GUID*" Then
If UCase(ws.Cells(ColNumb, RowNumb).Text) = "GUID" Then
Set FindGUID = ws.Cells(ColNumb, RowNumb)
Exit Function
End If
ColNumb = ColNumb + 1
Wend
RowNumb = RowNumb + 1
Wend
Set FindGUID = ws.Cells(1, 1)
End Function

Private Function LastColumn(ByRef ws As Worksheet) As Long
LastColumn = ws.Cells.Find(What:="*", _
After:=ws.Cells(1, 1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End Function

Private Function LastRow(ByRef ws As Worksheet) As Long
LastRow = ws.Cells.Find(What:="*", _
After:=ws.Cells(1, 1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End Function

Private Function LastCell(ByRef ws As Worksheet) As Range
Dim lngLastRow As Long
Dim lngLastColumn As Long

lngLastRow = LastRow(ws)
lngLastColumn = LastColumn(ws)

If lngLastRow = 0 Then
lngLastRow = 1
End If
If lngLastColumn = 0 Then
lngLastRow = 1
End If

Set LastCell = ws.Cells(lngLastRow, lngLastColumn)

End Function

 

[Tim Williams]

I see why you left it out. Without going through it in detail:

1. Why create a new instance of Excel for the second workbook?
2. Why not just pastespecial into the first cell of your destination range?

xlsWs.Cells(NextxlsRow, xlsGUIDCol).PasteSpecial xlPasteValues

Tim

 

[Gary Orr]

1. Because I use other applications. I may gather information from Excel and
use it in AutoCAD (or access, or word, take your pick). This method of coding
has served me well in working across differing applications that support VBA
via quick cut and paste of "code snippets". The final code will specify
seperate instances for the source file and for the target file for precise
control of which instance I'm referring to. (while testing your suggestion I
ran into the fact that I already had a seperate session of Excel running and
it started pasting information into it because I was using such simple coding
methods).

2. My thought was to avoid the very issue that I'm having: To avoid a dialog
box due to the "paste to" range being a different size than the "copy from"
range.
But to be thouough I ran it per your suggestion and it works, so: while I
have a workable solution for now I'm even more confused than before as to why.

Gary