Consulting

Results 1 to 10 of 10

Thread: Annoying VBA

  1. #1
    Administrator
    VP-Knowledge Base
    VBAX Master
    Joined
    Jan 2005
    Location
    Porto Alegre - RS - Brasil
    Posts
    1,219
    Location

    Question Annoying VBA

    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.

    I have a VBA code that works fine on it but is TOO slow:

    Sub Test()
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     aNome = ActiveSheet.Name
     Nova = "NC_" & Right(aNome, 3)
     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
     Sheets(Nova).Activate
     Range("A1:F21").Select
     End Sub
    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.

    Sub test2()
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     aNome = ActiveSheet.Name
     Nova = "NC_" & Right(aNome, 3)
     Dim filterRng As Range
     Set filterRng = Nothing
     With Sheets(aNome)
     Set filterRng = .Range("A1", .Range("K65536").End(xlUp))
     With filterRng
     .AutoFilter field:=1, Criteria1:="=NC"
     .SpecialCells(xlCellTypeVisible).Copy Sheets(Nova).Range("A1")
     .SpecialCells(xlCellTypeVisible).Delete
     .Cells(1).EntireRow.Insert
     End With
     Sheets(Nova).Range("1:1").Copy .Range("1:1")
     End With
     Set filterRng = Nothing
     Sheets(Nova).Activate
     ActiveWorkbook.Names.Add Name:="tblNC", RefersToR1C1:="=NC_nov!R1C1:R21C6"
     Range("A1").Select
     Sheets(aNome).Activate
     Application.ScreenUpdating = True
     Application.DisplayAlerts = True
     End Sub
    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?
    Last edited by Jacob Hilderbrand; 01-08-2005 at 07:59 PM. Reason: Solved
    Best Regards,

    Carlos Paleo.

    To every problem there is a solution, even if I dont know it, so this posting is provided "AS IS" with no warranties.

    If Debugging is harder than writing a program and your code is as good as you can possibly make
    it, then by definition you're not smart enough to debug it.




    http://www.mugrs.org

  2. #2
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    You can't post html code. Just regular text, bbcode, and you can also post an attachment.

  3. #3
    Administrator
    VP-Knowledge Base VBAX Master
    Joined
    Jan 2005
    Location
    Porto Alegre - RS - Brasil
    Posts
    1,219
    Location
    Hi Jacob,

    sorry. I have edited my post.
    Best Regards,

    Carlos Paleo.

    To every problem there is a solution, even if I dont know it, so this posting is provided "AS IS" with no warranties.

    If Debugging is harder than writing a program and your code is as good as you can possibly make
    it, then by definition you're not smart enough to debug it.




    http://www.mugrs.org

  4. #4
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Ok, it looks much better now. Also if you are going to cross post to different forums please provide a link. That way people don't waste their time posting if you already got an answer somewhere else.

    http://www.mrexcel.com/board2/viewto...8a24176b4bc2d8

  5. #5
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    See if this works for you.

    Sub test2()
    Dim filterRng       As Range
     Dim LastRow         As Long
     Dim Nova            As String
     Dim Nome            As String
    Application.ScreenUpdating = False
         Application.DisplayAlerts = False
    aNome = ActiveSheet.Name
         Nova = "NC_" & Right(aNome, 3)
         Set filterRng = Nothing
         LastRow = Sheets(aNome).Range("K65536").End(xlUp).Row
         Set filterRng = Sheets(aNome).Range("A1:A" & LastRow)
         With filterRng
             .AutoFilter field:=1, Criteria1:="=NC"
             .SpecialCells(xlCellTypeVisible).Copy Sheets(Nova).Range("A1")
             .SpecialCells(xlCellTypeVisible).Delete
             .Cells(1).EntireRow.Insert
         End With
         Sheets(Nova).Range("1:1").Copy Sheets(aNome).Range("1:1")
         Set filterRng = Nothing
         Sheets(Nova).Activate
         ActiveWorkbook.Names.Add Name:="tblNC", RefersToR1C1:="=NC_nov!R1C1:R21C6"
         Range("A1").Select
         Sheets(aNome).Activate
    Application.ScreenUpdating = True
         Application.DisplayAlerts = True
    End Sub

  6. #6
    Administrator
    VP-Knowledge Base VBAX Master
    Joined
    Jan 2005
    Location
    Porto Alegre - RS - Brasil
    Posts
    1,219
    Location
    Hi Jacob,

    nope, didnt work at all. But I just have found a solution that worked out.

    I copy it here to help more people. Thanks for the support.

    Sub Test()
     aNome = ActiveSheet.Name 
      Nova = "NC_" & Right(aNome, 3)
     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)
     End Sub
    Best Regards,

    Carlos Paleo.

    To every problem there is a solution, even if I dont know it, so this posting is provided "AS IS" with no warranties.

    If Debugging is harder than writing a program and your code is as good as you can possibly make
    it, then by definition you're not smart enough to debug it.




    http://www.mugrs.org

  7. #7
    Site Admin
    Jedi Master
    VBAX Guru Jacob Hilderbrand's Avatar
    Joined
    Jun 2004
    Location
    Roseville, CA
    Posts
    3,712
    Location
    Glad you got it working. I also editted your posts to use VBA tags. That way the VBA code appears as it would in the VBE which is a pretty nice feature.

    To do that just put (VBA) at the beginning of your code and (/VBA) at the end. When you really do this use square brackets [ ] though.

  8. #8
    Administrator
    VP-Knowledge Base VBAX Master
    Joined
    Jan 2005
    Location
    Porto Alegre - RS - Brasil
    Posts
    1,219
    Location
    Thanks Jacob!

    Sorry for the VBA, I still learning how to use this forum, but I must tell that I liked it a lot!
    Best Regards,

    Carlos Paleo.

    To every problem there is a solution, even if I dont know it, so this posting is provided "AS IS" with no warranties.

    If Debugging is harder than writing a program and your code is as good as you can possibly make
    it, then by definition you're not smart enough to debug it.




    http://www.mugrs.org

  9. #9
    Site Admin
    Urban Myth
    VBAX Guru
    Joined
    May 2004
    Location
    Oregon, United States
    Posts
    4,940
    Location
    Quote Originally Posted by DRJ
    Ok, it looks much better now. Also if you are going to cross post to different forums please provide a link. That way people don't waste their time posting if you already got an answer somewhere else.

    http://www.mrexcel.com/board2/viewto...8a24176b4bc2d8
    Also here: http://www.mrexcel.com/board2/viewtopic.php?t=122970

    Glad you got it working Paleo.

  10. #10
    Administrator
    VP-Knowledge Base VBAX Master
    Joined
    Jan 2005
    Location
    Porto Alegre - RS - Brasil
    Posts
    1,219
    Location
    Thanks Zack,

    Ok, I will always put a link when a cross post. Sorry, I didnt think I should do that, because it could be considered wrong. You know, it could be considered as marketing another forum.

    By the way, as I have liked more that first solution of yours I have just adapted it and got it working just fine.

    Here is its final code:

    Option Explicit 
     
    Sub TestForMrE() 
    Dim aNome As String, Nova As String, filterRng As Range, nommes As String 
    While (Len(nommes) > 3) Or nommes = "" 
    nommes = InputBox("Type month's name with 3 characters", "Report Month", _ 
    "jan, feb, mar, apr, mai, jun, jul, aug, sep, oct, nov, dec") 
    Wend 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    aNome = "can_" & LCase(nommes) 
    Nova = "NC_" & LCase(nommes) 
    ActiveSheet.Name = aNome 
    Sheets.Add 
    ActiveSheet.Name = Nova 
    With Sheets(aNome) 
    '.Range("A1").EntireRow.Copy Sheets(Nova).Range("A1") 
    Set filterRng = .Range("A1", .Range("D65536").End(xlUp)) 
    With filterRng 
    .AutoFilter field:=1, Criteria1:="=NC" 
    On Error Resume Next
    .SpecialCells(xlCellTypeVisible).Copy Sheets(Nova).Range("A2")
    .SpecialCells(xlCellTypeVisible).Delete 
    .Cells(1).EntireRow.Insert 
    End With 
    Sheets(Nova).Range("1:1").Copy .Range("1:1") 
    End With 
    Sheets(Nova).Activate 
    Application.DisplayAlerts = True 
    Application.ScreenUpdating = True 
    End Sub
    Last edited by Paleo; 01-09-2005 at 08:03 AM. Reason: Mispelling
    Best Regards,

    Carlos Paleo.

    To every problem there is a solution, even if I dont know it, so this posting is provided "AS IS" with no warranties.

    If Debugging is harder than writing a program and your code is as good as you can possibly make
    it, then by definition you're not smart enough to debug it.




    http://www.mugrs.org

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •