Annoying VBA

P

Paleo

New Member
Joined
Jan 4, 2005
Messages
43
Hi people,



I am having an annoying VBA problem. I have a spreadsheet that has many Subs on its 52 Mb and uses data from another worksheet that has 48 Mb and a text file that has another 11 Mb.



It looks like this at the point where I am getting an error:
Sheet1.xls
ABCDE
1TypeProducerItemValueCost
2OP14642051747S1390281,6733
3OP14642051748S1390281,6733
4OP140851863393M938476,917099,0329
5OP111301MIE400MEXE01225229,95
6OP111301CPE275ADVE0112541301,006
7OP111301CPE283ADVE01842,4860,9328
8OP111301CPE292ADVE01416425,152
9OP111301CPE299ADVE01607,2620,5584
10OP111301MII400BE012071,32116,8686
11OP111301MII5300E01730,4746,4688
12OP111301MOI5300E01172172
13NC141293456,510
14OP6448501107245/00092,9466,12
15OP6448501112916/000222131,31
16OP6448501112916/00014887,54
17OP6448501112916/00014887,54
18NC1412901119241/000108,36820,44
19OP14827020033P2156,38123,9
20OP14827020033P2491,48389,4
21OP14827020033P2491,48389,4
22OP14827020033P2491,48389,4
23OP14827020033P2335,1265,5
24OP14827020033P2647,86513,3
25OP14827020033P2982,96778,8
26NC14827020033P296,321982,4
27OP64485020041P1120,673,4865
28OP64485020041P1120,673,4865
29OP64485020041P1120,673,4865
30OP64485020041P1225,42146,973
can_dst



I have a VBA code that works fine on it but is TOO slow:<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Test()
    Application.ScreenUpdating =<SPAN style="color:#00007F">False</SPAN>
    Application.DisplayAlerts =<SPAN style="color:#00007F">False</SPAN>
    aNome = ActiveSheet.Name
    Nova = "NC_" & Right(aNome, 3)
    <SPAN style="color:#00007F">Dim</SPAN> i<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN>, n<SPAN style="color:#00007F">As</SPAN><SPAN style="color:#00007F">Long</SPAN>
    n = 2
    Range("A1").EntireRow.Copy Sheets(Nova).Range("A1")
    <SPAN style="color:#00007F">For</SPAN> i = Range("A65536").End(xlUp).Row<SPAN style="color:#00007F">To</SPAN> 1<SPAN style="color:#00007F">Step</SPAN> -1
        <SPAN style="color:#00007F">If</SPAN> Range("A" & i).Value = "NC"<SPAN style="color:#00007F">Then</SPAN>
            Range("A" & i).EntireRow.Copy Sheets(Nova).Range("A" & n)
            n = n + 1
            Range("C" & i).EntireRow.Delete
        <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Next</SPAN> i
    Sheets(Nova).Activate
    Range("A1:F21").Select<SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">Sub</SPAN>



And when I try to modify it to make it faster, using the code below I get an error 1004 message, telling me an error occurred at the copy function from the range class.<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> test2()
    Application.ScreenUpdating =<SPAN style="color:#00007F">False</SPAN>
    Application.DisplayAlerts =<SPAN style="color:#00007F">False</SPAN>
    aNome = ActiveSheet.Name
    Nova = "NC_" & Right(aNome, 3)
    <SPAN style="color:#00007F">Dim</SPAN> filterRng<SPAN style="color:#00007F">As</SPAN> Range
    <SPAN style="color:#00007F">Set</SPAN> filterRng =<SPAN style="color:#00007F">Nothing</SPAN>
    <SPAN style="color:#00007F">With</SPAN> Sheets(aNome)
        <SPAN style="color:#00007F">Set</SPAN> filterRng = .Range("A1", .Range("K65536").End(xlUp))
        <SPAN style="color:#00007F">With</SPAN> filterRng
            .AutoFilter field:=1, Criteria1:="=NC"
            .SpecialCells(xlCellTypeVisible).Copy Sheets(Nova).Range("A1")
            .SpecialCells(xlCellTypeVisible).Delete
            .Cells(1).EntireRow.Insert
        <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">With</SPAN>
        Sheets(Nova).Range("1:1").Copy .Range("1:1")
    <SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">With</SPAN>
    <SPAN style="color:#00007F">Set</SPAN> filterRng =<SPAN style="color:#00007F">Nothing</SPAN>
    Sheets(Nova).Activate
    ActiveWorkbook.Names.Add Name:="tblNC", RefersToR1C1:="=NC_nov!R1C1:R21C6"
    Range("A1").Select
    Sheets(aNome).Activate
    Application.ScreenUpdating =<SPAN style="color:#00007F">True</SPAN>
    Application.DisplayAlerts =<SPAN style="color:#00007F">True</SPAN><SPAN style="color:#00007F">End</SPAN><SPAN style="color:#00007F">Sub</SPAN></FONT>



The interesting part is that I get that error AFTER it has copied all the cells.



So, does anyone knows whats going on? May anyone help me out, please?
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Sort by date Sort by votes
In the first macro you posted, try replacing this :-

Code: 
Dim i As Long, n As Long
n = 2
Range("A1").EntireRow.Copy Sheets(Nova).Range("A1")
For i = Range("A65536").End(xlUp).Row To 1 Step -1
    If Range("A" & i).Value = "NC" Then
        Range("A" & i).EntireRow.Copy Sheets(Nova).Range("A" & n)
        n = n + 1
        Range("C" & i).EntireRow.Delete
    End If
Next i

With this :-

Code: 
Dim rng As Range
Columns(1).Insert
Set rng = Range([A2], [B65536].End(xlUp)(1, 0))
With rng
    .FormulaR1C1 = "=IF(RC[1]=""NC"",""d"",1)"
    .EntireRow.Sort Key1:=[A2], Order1:=xlAscending, Header:=xlNo
    On Error Resume Next
    .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Cut Sheets(Nova).[A2]
    On Error GoTo 0
    .EntireColumn.Delete
End With
Sheets(Nova).Columns(1).Delete
Rows(1).Copy Sheets(Nova).Rows(1)
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question
Adding a custom message.
Replies
1
Views
437
Micron
M
G
  • Question
Excel VBA to reply to existing email chain and add workbook as attachment
Replies
4
Views
222
gopalgriffith
G
J
  • Solved
Email body not showing using html.
Replies
3
Views
598
Logit
Logit
M
  • Solved
VBA Multiple Worksheet Change Events
Replies
3
Views
633
Joe4
Joe4
J
  • Question
Outlook Hypperlink of fila in email body will not open
Replies
1
Views
446
josros60
J

Forum statistics

Threads
1,215,152
Messages
6,123,323
Members
449,094
Latest member
Chestertim

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top