Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...
MS Office Forum / Excel / Programming / March 2008

Tip: Looking for answers? Try searching our database.

DECLARE VARIABLES PROBLEM

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
ytayta555 - 14 Mar 2008 02:01 GMT
HI ALL

I have this macro whitch copy antire row
from one wbook to another If a value is
>=x ;it works with 1 workbook    :

PART 1 OF TOPIC !

Option Explicit
Sub Copy_Ranges()

Dim FromWks As Worksheet
   Dim DestWks As Worksheet
   Dim NextRow As Long
   Dim myCell As Range
   Dim myRng As Range

Set FromWks = Workbooks("YTA1.xls").Worksheets("sheet1")
   Set DestWks = Workbooks("R1.xls").Worksheets("sheet1")

With FromWks
       Set myRng = .Range("BD91", .Cells(.Rows.Count,
"BD").End(xlUp))
   End With

For Each myCell In myRng.Cells
       If myCell.Value <= 32 Then
           With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
               myCell.EntireRow.Copy _
                   Destination:=.Cells(NextRow, "A")
           End With
       End If
   Next myCell

End Sub

PART 2 OF TOPIC .

I change this macro for loop in 3 steps ;
the macro becomed so :

Option Explicit
Sub Copy_Ranges()

   Dim FromWks As Worksheet
   Dim DestWks As Worksheet
   Dim NextRow As Long
   Dim myCell As Range
   Dim myRng1 As Range
Dim myRng2 As Range
Dim myRng3 As Range

    Set FromWks = Workbooks("Registru1.xls").Worksheets("1")
       Set DestWks = Workbooks("R1.xls").Worksheets("1")

With FromWks
       Set myRng1 = .Range("BD91:BD22000")
   End With
With FromWks
       Set myRng2 = .Range("BD22001:BD44000")
   End With
With FromWks
       Set myRng3 = .Range("BD44001:BD65536")
   End With

Sheets("1").Select
   Range("B91:B7000").Select
   Selection.AutoFill Destination:=Range("B91:BB7000"),
Type:=xlFillDefault
   Range("B7001:B14000").Select
   Selection.AutoFill Destination:=Range("B7001:BB14000"),
Type:=xlFillDefault
   Range("B14001:B22000").Select
   Selection.AutoFill Destination:=Range("B14001:BB22000"),
Type:=xlFillDefault
    For Each myCell In myRng1.Cells
           If myCell.Value >=33 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                     .cells(nextrow,"A").pastespecial paste:=xlpastevalues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C91:BB22005").Select
   Selection.ClearContents
Sheets("1").Select
   Range("B22001:B29000").Select
   Selection.AutoFill Destination:=Range("B22001:BB29000"),
Type:=xlFillDefault
   Range("B29001:B36000").Select
   Selection.AutoFill Destination:=Range("B29001:BB36000"),
Type:=xlFillDefault
   Range("B36001:B44000").Select
   Selection.AutoFill Destination:=Range("B36001:BB44000"),
Type:=xlFillDefault
    For Each myCell In myRng2.Cells
           If myCell.Value >=33 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                     .cells(nextrow,"A").pastespecial paste:=xlpastevalues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C22001:BB44005").Select
   Selection.ClearContents
Sheets("1").Select
   Range("B44001:B51000").Select
   Selection.AutoFill Destination:=Range("B44001:BB51000"),
Type:=xlFillDefault
   Range("B51001:B58000").Select
   Selection.AutoFill Destination:=Range("B51001:BB58000"),
Type:=xlFillDefault
   Range("B58001:B65536").Select
   Selection.AutoFill Destination:=Range("B58001:BB65536"),
Type:=xlFillDefault
    For Each myCell In myRng3.Cells
           If myCell.Value >=33 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                     .cells(nextrow,"A").pastespecial paste:=xlpastevalues

           End With
       End If
   Next myCell

End Sub

PART 3 OF TOPIC .

For open 3 workbook this macro and
work with them , I ' ve done this changes  :

Option Explicit
Sub Copy_Ranges()

   Dim FromWks1 As Worksheet
Dim FromWks2 As Worksheet
Dim FromWks3 As Worksheet
Dim DestWks As Worksheet
Dim NextRow As Long
   Dim myCell As Range
   Dim myRng1 As Range
Dim myRng2 As Range
Dim myRng3 As Range

Workbooks.Open ("D:\WAVE\YTA1.xls")

Set FromWks1 = Workbooks("YTA1.xls").Worksheets("1")

Set DestWks = Workbooks("R1.xls").Worksheets("1")

With FromWks1
       Set myRng1 = .Range("BD91:BD22000")
   End With
With FromWks1
       Set myRng2 = .Range("BD22001:BD44000")
   End With
With FromWks1
       Set myRng3 = .Range("BD44001:BD65536")
   End With

Sheets("1").Select
   Range("B91:B7000").Select
   Selection.AutoFill Destination:=Range("B91:BB7000"),
Type:=xlFillDefault
   Range("B7001:B14000").Select
   Selection.AutoFill Destination:=Range("B7001:BB14000"),
Type:=xlFillDefault
   Range("B14001:B22000").Select
   Selection.AutoFill Destination:=Range("B14001:BB22000"),
Type:=xlFillDefault
   For Each myCell In myRng1.Cells
           If myCell.Value >= 32 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                   .Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C91:BB22005").Select
   Selection.ClearContents
Sheets("1").Select
   Range("B22001:B29000").Select
   Selection.AutoFill Destination:=Range("B22001:BB29000"),
Type:=xlFillDefault
   Range("B29001:B36000").Select
   Selection.AutoFill Destination:=Range("B29001:BB36000"),
Type:=xlFillDefault
   Range("B36001:B44000").Select
   Selection.AutoFill Destination:=Range("B36001:BB44000"),
Type:=xlFillDefault
   For Each myCell In myRng2.Cells
           If myCell.Value >= 32 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                   .Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C22001:BB44005").Select
   Selection.ClearContents
Sheets("1").Select
   Range("B44001:B51000").Select
   Selection.AutoFill Destination:=Range("B44001:BB51000"),
Type:=xlFillDefault
   Range("B51001:B58000").Select
   Selection.AutoFill Destination:=Range("B51001:BB58000"),
Type:=xlFillDefault
   Range("B58001:B65536").Select
   Selection.AutoFill Destination:=Range("B58001:BB65536"),
Type:=xlFillDefault
   For Each myCell In myRng3.Cells
           If myCell.Value >= 32 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                   .Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C44001:BB65536").Select
   Selection.ClearContents
Workbooks("YTA1.xls").Close SaveChanges:=False

Workbooks.Open ("D:\WAVE\YTA2.xls")

Set FromWks2 = Workbooks("YTA2.xls").Worksheets("1")
With FromWks2
       Set myRng1 = .Range("BD91:BD22000")
   End With
With FromWks2
       Set myRng2 = .Range("BD22001:BD44000")
   End With
With FromWks2
       Set myRng3 = .Range("BD44001:BD65536")
   End With

Sheets("1").Select
   Range("B91:B7000").Select
   Selection.AutoFill Destination:=Range("B91:BB7000"),
Type:=xlFillDefault
   Range("B7001:B14000").Select
   Selection.AutoFill Destination:=Range("B7001:BB14000"),
Type:=xlFillDefault
   Range("B14001:B22000").Select
   Selection.AutoFill Destination:=Range("B14001:BB22000"),
Type:=xlFillDefault
   For Each myCell In myRng1.Cells
           If myCell.Value >= 32 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                   .Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C91:BB22005").Select
   Selection.ClearContents
Sheets("1").Select
   Range("B22001:B29000").Select
   Selection.AutoFill Destination:=Range("B22001:BB29000"),
Type:=xlFillDefault
   Range("B29001:B36000").Select
   Selection.AutoFill Destination:=Range("B29001:BB36000"),
Type:=xlFillDefault
   Range("B36001:B44000").Select
   Selection.AutoFill Destination:=Range("B36001:BB44000"),
Type:=xlFillDefault
   For Each myCell In myRng2.Cells
           If myCell.Value >= 32 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                   .Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C22001:BB44005").Select
   Selection.ClearContents
Sheets("1").Select
   Range("B44001:B51000").Select
   Selection.AutoFill Destination:=Range("B44001:BB51000"),
Type:=xlFillDefault
   Range("B51001:B58000").Select
   Selection.AutoFill Destination:=Range("B51001:BB58000"),
Type:=xlFillDefault
   Range("B58001:B65536").Select
   Selection.AutoFill Destination:=Range("B58001:BB65536"),
Type:=xlFillDefault
   For Each myCell In myRng3.Cells
           If myCell.Value >= 32 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                   .Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C44001:BB65536").Select
   Selection.ClearContents
Workbooks("YTA2.xls").Close SaveChanges:=False

Workbooks.Open ("D:\WAVE\YTA3.xls")

Set FromWks3 = Workbooks("YTA3.xls").Worksheets("1")
With FromWks3
       Set myRng1 = .Range("BD91:BD22000")
   End With
With FromWks3
       Set myRng2 = .Range("BD22001:BD44000")
   End With
With FromWks3
       Set myRng3 = .Range("BD44001:BD65536")
   End With

Sheets("1").Select
   Range("B91:B7000").Select
   Selection.AutoFill Destination:=Range("B91:BB7000"),
Type:=xlFillDefault
   Range("B7001:B14000").Select
   Selection.AutoFill Destination:=Range("B7001:BB14000"),
Type:=xlFillDefault
   Range("B14001:B22000").Select
   Selection.AutoFill Destination:=Range("B14001:BB22000"),
Type:=xlFillDefault
   For Each myCell In myRng1.Cells
           If myCell.Value >= 32 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                   .Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C91:BB22005").Select
   Selection.ClearContents
Sheets("1").Select
   Range("B22001:B29000").Select
   Selection.AutoFill Destination:=Range("B22001:BB29000"),
Type:=xlFillDefault
   Range("B29001:B36000").Select
   Selection.AutoFill Destination:=Range("B29001:BB36000"),
Type:=xlFillDefault
   Range("B36001:B44000").Select
   Selection.AutoFill Destination:=Range("B36001:BB44000"),
Type:=xlFillDefault
   For Each myCell In myRng2.Cells
           If myCell.Value >= 32 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                   .Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C22001:BB44005").Select
   Selection.ClearContents
Sheets("1").Select
   Range("B44001:B51000").Select
   Selection.AutoFill Destination:=Range("B44001:BB51000"),
Type:=xlFillDefault
   Range("B51001:B58000").Select
   Selection.AutoFill Destination:=Range("B51001:BB58000"),
Type:=xlFillDefault
   Range("B58001:B65536").Select
   Selection.AutoFill Destination:=Range("B58001:BB65536"),
Type:=xlFillDefault
   For Each myCell In myRng3.Cells
           If myCell.Value >= 32 Then
                   With DestWks
               NextRow = .Cells(.Rows.Count, "BD").End(xlUp).Row + 1
                myCell.EntireRow.Copy
                   .Cells(NextRow, "A").PasteSpecial
Paste:=xlPasteValues

           End With
       End If
   Next myCell
Application.CutCopyMode = False
Sheets("1").Select
   Range("C44001:BB65536").Select
   Selection.ClearContents
Workbooks("YTA3.xls").Close SaveChanges:=False

End Sub

PART 4 OF TOPIC  .

I  want to work with 10 workbooks in one
macro . Name of this workbooks is from YTA1
to YTA10 .

MY PROBLEM IS  : HOW CAN I declare the variables for
all workbooks ?THE ONLY PROBLEM IS TO DECLARE
VARIABLES IN THIS MACRO ! Please don't impresionate
for the big size of this macro , only problem is to declare
variables for the 10  workbooks and them Rng1 , Rng2 and
Rng3 ! !
Something I write wrong , because after first
workbook the macro don't work with speed !! It copy entire row in
the other workbook very slow !

(ps:I have 231 workbooks , named from YTA1 to YTA231,
but I think it cann't be posible to work with all them
in one only macro [ a macro cann't be bigger of 64 kb ! ])

Any sugestion will be wellkome ! Many thanks
Reply to this Message
DownThePaint - 14 Mar 2008 02:50 GMT
Hi ytayta555;

This may not help but i'l take a shot at it.  My first suggestions would be
to switch to a database solution.  If you have that much data is seems like
it might be time to to do that.  Second, have you tried going back and forth
between the workbooks by using the Windows.Workbooks("xxx").Activate method.  
Third, you might could bring all the worksheets into one workbook instead of
so many workbooks.  Fourth you might use linking to have all 200 + workbook
answer sheets link into a master workbook.

I hope it helps and good luck,

> HI ALL
>
[quoted text clipped - 287 lines]
> Type:=xlFillDefault
>     Range("B29001:B36000").Select
Reply to this Message
ytayta555 - 14 Mar 2008 04:52 GMT
On 14 Mar, 03:50, DownThePaint
<DownThePa...@discussions.microsoft.com> wrote:
> Hi ytayta555;

Thank for sugestion Dawn !

> Third, you might could bring all the worksheets into one workbook instead of
> so many workbooks.  Fourth you might use linking to have all 200 + workbook
> answer sheets link into a master workbook.

I can't do this because my powerless resource sistem ...256mb ,
and it don't open a wbook such that ; every wbook have now
10 mb ;

Second, have you tried going back and forth
> between the workbooks by using the Windows.Workbooks("xxx").Activate method

I don't know to work with this metod .....

> If you have that much data is seems like
> it might be time to to do that.  .

it take 3 sessions of 2,5 hours

> This may not help but i'l take a shot at it.  My first suggestions would be
> to switch to a database solution.

how look a database solution ?.... I want to work in excel and VBA ...

Now , I have some macros which work with a half of this workbooks
(108 wbooks) ; with the macro I  posted here , I can work in all
231 workbooks , but,  I tried to get here the right declare of
variables ,
and to find where the macro is wrong that it after first workbook
don't have the same speed of copy entire rows from one wbook
to another according to the criteria >=32;

Many thanks for your sugestions , Dawn
Reply to this Message
ytayta555 - 14 Mar 2008 04:56 GMT
On 14 Mar, 03:50, DownThePaint
<DownThePa...@discussions.microsoft.com> wrote:
> Hi ytayta555;

>  Second, have you tried going back and forth
> between the workbooks by using the Windows.Workbooks("xxx").Activate method.  

I forget to explain , my sistem is powerless and I must
open and close every workbook before I begin the querry
in it ; I can't open first 10 workbooks , for example ;

Respectfully
Reply to this Message
michael.beckinsale - 14 Mar 2008 09:47 GMT
Hi ytayta55,

From a brief look at your code & requirements you need to loop through
the 231 workbooks. Try including something like this:

For Each i From 1 to 231
  Set FromWks = Workbooks("YTA" & i & ".xls").Worksheets("sheet1")
  >>>existing code<<<
Next i

Also put his at the beginnning of your code to speed things up:

Application.ScreenUpdating = False
Application.Calculation = xlManual

Also much of your code is inefficient, you should always try to avoid
selecting, so replace this type of statement:

Sheets("1").Select
Range("C22001:BB44005").Select
Selection.ClearContents

With:
Sheets("1").Range("C22001:BB44005").ClearContents

HTH

Michael
Reply to this Message
michael.beckinsale - 14 Mar 2008 09:53 GMT
Hi ytayta55,

Sorry typo in original reply:

For Each i = 1 to 231
  Set FromWks = Workbooks("YTA" & i & ".xls").Worksheets("sheet1")
  >>>existing code<<<
Next i

Michael
Reply to this Message
michael.beckinsale - 14 Mar 2008 10:01 GMT
Must be a bad morning, sorry typo in reposting:

For  i = 1 to 231
   Set FromWks = Workbooks("YTA" & i & ".xls").Worksheets("sheet1")
   >>>existing code<<<
Next i

Michael
Reply to this Message
ytayta555 - 19 Mar 2008 16:53 GMT
>Also much of your code is inefficient, you should always try to avoid
>selecting, so replace this type of statement:
[quoted text clipped - 5 lines]
>HTH
>Michael

Thank you very much Michael , this really helped me !
The macro work with this faster ! Excuse me for late
feedback/reply .

>Must be a bad morning, sorry typo in reposting:
>For  i = 1 to 231
>    Set FromWks = Workbooks("YTA" & i & ".xls").Worksheets("sheet1")
  >>>existing code<<<
>Next i
>Michael

This doesn't help me very much because the workbooks
are not open ;
Know somebady if it is posiblle to combin this
function (,,for  ... to ") with ,,OPEN" Method ??
Thank ypu very much again and apologise for
late feedback .
Reply to this Message
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage
Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.