Results 1 to 2 of 2

Thread: VBA Macro Start to finish way to long
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Mar 2012
    Posts
    70
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA Macro Start to finish way to long

    I have made this vba macro up but when I use it it makes my files double in size when I save it.

    I would like some help making it shorter but I dont know were to start.

    Code:
    Sub Move_Final_to_JBA()Dim SheetName As String
    Dim wkSht As Worksheet
    Dim sh1 As Worksheet
    Dim sh5 As Worksheet
    Dim i As Long, sh As Worksheet
    Dim lastrow As Long
    Dim ws As Worksheet
    Dim cell As Range
    Dim LR As Long, r As Range, r1 As Range, r2 As Range, mr As Range
    
    
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    
    
    Application.ScreenUpdating = False
    
    
    Rows.EntireRow.Hidden = False
    
    
        Sheets("MYOB_JBA").Select
        
        Columns("C:D").EntireColumn.Hidden = False
        
        Range("B1:C6").Select
        Selection.ClearContents
        
        Range("A10:O10").Select
        Selection.ClearContents
        
        With Sheets("MYOB_JBA") '<--| change "mysheet" to your actual sheet name
        Intersect(.Range(.Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("A:Q")).Clear
        End With
       
        Range("A14:R1284").Select
        Selection.Interior.Color = xlNone
        
        Range("A14:Q1284").Select
        Selection.Font.Color = RGB(0, 0, 0)
        
        Range(("A14:Q1284")).Font.Bold = False
        
        Rows("14:1284").RowHeight = 15
    
    
    
    
    Sheets("MYOB_JBA").Select
    
    
    
    
    Set sh1 = Worksheets("Final")
    Set sh5 = Worksheets("MYOB_JBA")
    
    
    
    
    sh1.Range("A14:A1284").Copy  'Column B
    'sh5.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
    sh5.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = True
    
    
    sh1.Range("C14:C1284").Copy  'Column C
    'sh5.Cells(Rows.Count, 3).End(xlUp).Offset(13, 0).PasteSpecial Paste:=xlPasteFormats
    sh5.Cells(Rows.Count, 3).End(xlUp).Offset(13, 0).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = True
    
    
    sh1.Range("E14:E1284").Copy 'Column D
    'sh5.Cells(Rows.Count, 4).End(xlUp).Offset(13, 0).PasteSpecial Paste:=xlPasteFormats
    sh5.Cells(Rows.Count, 4).End(xlUp).Offset(13, 0).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = True
    
    
    sh1.Range("G14:G1284").Copy  'Column E
    'sh5.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
    sh5.Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = True
    
    
    sh1.Range("J14:J285").Copy  'Column F
    'sh5.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
    sh5.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = True
    
    
    sh1.Range("H286:H1236").Copy  'Column F
    'sh5.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
    sh5.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = True
    
    
    sh1.Range("I1237:I1284").Copy  'Column F
    'sh5.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
    sh5.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = True
    
    
    Range("J14").Formula = "=IF(E14>0,""0"")"
    Range("J14").AutoFill Destination:=Range("J14:J159")
        
    Range("K14").Formula = "=IF(E14>0,""0"")"
    Range("K14").AutoFill Destination:=Range("K14:K159")
    
    
    sh1.Range("L14:L1284").Copy 'Column I
    'sh5.Cells(Rows.Count, 9).End(xlUp).Offset(13, 0).PasteSpecial Paste:=xlPasteFormats
    sh5.Cells(Rows.Count, 9).End(xlUp).Offset(13, 0).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = True
    
    
    sh1.Range("Z160:Z1284").Copy 'Column J
    'sh5.Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
    sh5.Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = True
    
    
    sh1.Range("J160:J1284").Copy 'Column K
    'sh5.Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteFormats
    sh5.Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = True
    
    
    sh5.Select
        
        Range(("A14:Q1284")).Font.Bold = False
    
    
        lastrow = Cells(Rows.Count, "B").End(xlUp).Row
    
    
        Range("G14").Formula = "=(IF((Final!$B$10)="""","""",IF((Final!$B$10)=""No"","""",IF((Final!$B$10)=""N"",""""," & _
         "IF(AND((F14)>0,(Final!$B$10)=""M""),(F14)*0.02,IF(AND((F14)>0,(Final!$B$10)=""B""),(F14)*0.05,""""))))))"
        Range("G14").AutoFill Destination:=Range("G14:G" & lastrow)
    
    
        Range("H14").Formula = "=IFERROR(IF(E14>0,(F14-E14)/F14,0),0)"
        Range("H14").AutoFill Destination:=Range("H14:H" & lastrow)
    
    
        Range("L14").Formula = "=IFERROR(IF(K14>0,K14*0.02,""No""),0)"
        Range("L14").AutoFill Destination:=Range("L14:L" & lastrow)
    
    
        Range("M14").Formula = "=IFERROR(IF(J14>0,(K14-J14)/K14,0),0)"
        Range("M14").AutoFill Destination:=Range("M14:M" & lastrow)
            
        Range("N14").Formula = "=IF(SUM(COUNTIF(C14,""*""&{""Free Standing"",""Parkfit Structure"",""Single Structure""," & _
          """Orbit Structure"",""Orbit 2 Structure"",""Parkfit Boltdown Structure"",""Outdoor Furniture"",""Spring Rocker""," & _
          """Summit Range"",""Website/Catalogue Range"",""Essentials Play Structure"",""Swings"",""Fitness Track"",""Outdoor Gym Equipment""," & _
          """Special Item""}&""*"")),D14&"" ""&B14,"""")"
        Range("N14").AutoFill Destination:=Range("N14:N" & lastrow)
        
        Range("O14").Formula = "=IFERROR(IF(J14>0,(E14+J14),0),0)"
        Range("O14").AutoFill Destination:=Range("O14:O" & lastrow)
        
        Range("Q14").Formula = "=IFERROR(IF(O14>0,(P14-O14)/P14,0),0)"
        Range("Q14").AutoFill Destination:=Range("Q14:Q" & lastrow)
        
        Range("P14").Formula = "=IFERROR(IF(K14>0,(F14+G14+L14+K14),0),0)"
        Range("P14").AutoFill Destination:=Range("P14:P" & lastrow)
        
        Range("R14").Formula = "=TEXTJOIN("" - "",TRUE,N14)"
        Range("R14").AutoFill Destination:=Range("R14:R" & lastrow)
          
    
    
    SheetName = "Final"
    'SheetName = InputBox("Enter Option Number - this will update MYOB_JBA", "sheet name", SheetName)
    'Dim i As Long
    Dim myCol As Integer
    Dim MyRow As Integer
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 2
    MyRow = 1
            If Sheets(SheetName).Range("Client").Value <> "" Then  'Client
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("Client").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 2
    MyRow = 2
            If Sheets(SheetName).Range("ProjectName").Value <> "" Then  'Project Name
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("ProjectName").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 2
    MyRow = 3
            If Sheets(SheetName).Range("Street_Address").Value <> "" Then  'Project Name
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("Street_Address").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 2
    MyRow = 4
            If Sheets(SheetName).Range("ID_No").Value <> "" Then  'ID_No
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("ID_No").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 2
    MyRow = 5
            If Sheets(SheetName).Range("ProductionNo").Value <> "" Then  'ProductionNo
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("ProductionNo").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 2
    MyRow = 6
            If Sheets(SheetName).Range("OrderDate").Value <> "" Then  'ProductionNo
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("OrderDate").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 2
    MyRow = 7
            If Sheets(SheetName).Range("Rep_Name").Value <> "" Then  'Rep_Name
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("Rep_Name").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 2
    MyRow = 10
            If Sheets(SheetName).Range("OrderDate").Value <> "" Then  'ProductionNo
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("OrderDate").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 5
    MyRow = 10
            If Sheets(SheetName).Range("ID_No").Value <> "" Then  'ID_No
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("ID_No").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 6
    MyRow = 10
            If Sheets(SheetName).Range("ProductionNo").Value <> "" Then  'ID_No
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("ProductionNo").Value
                End If
                
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 7
    MyRow = 10
            If Sheets(SheetName).Range("Rep_Name").Value <> "" Then  'Rep_Name
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("Rep_Name").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 8
    MyRow = 10
            If Sheets(SheetName).Range("Client").Value <> "" Then  'Client
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("Client").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 12
    MyRow = 10
            If Sheets(SheetName).Range("Street_Address").Value <> "" Then  'Street_Address
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("Street_Address").Value
                End If
    
    
    lastrow = Sheets(SheetName).Range("B" & Rows.Count).End(xlUp).Row
    myCol = 15
    MyRow = 10
            If Sheets(SheetName).Range("Zone").Value <> "" Then  'Zone
                Sheets("MYOB_JBA").Cells(MyRow, myCol).Value = Sheets(SheetName).Range("Zone").Value
                End If
    
    
    lastrow = Cells(Rows.Count, "B").End(xlUp).Row
    
    
    Range("A14").Formula = "=IF(OR(B:B=""INSTALLATION EXTRAS""),""5-2101"",(IF(OR(B:B=""PREPARE SITE""),""5-2102"",(IF(OR(B:B=""EDGING""),""5-2103"",(IF(OR(B:B=""MULCH""),""5-2104""," & _
                              "(IF(OR(B:B=""RUBBER""),""5-2105"",(IF(OR(B:B=""CLEAN UP""),""5-2106"",(IF(OR(B:B=""GEO TEXTILES""),""5-2107"",(IF(OR(B:B=""SHADE STRUCTURES""),""5-2108""," & _
                              "(IF(OR(B:B=""MISCELLANEOUS WORKS""),""5-2109"",(IF(OR(B:B=""LABOUR AND HIRE""),""5-2110"",(IF(OR(B:B=""NON FA EQUIPMENT (Carvings Etc)""),""5-2210""," & _
                              "(IF(OR(B:B=""FREE STANDING ITEMS""),""5-2310"",(IF(OR(B:B=""Free Standing Items (Stainless Fasteners)""),""5-2310"",(IF(OR(B:B=""Free Standing Items (Stainless Steel)""),""5-2310""," & _
                              "IF(OR(B:B=""Free Standing Items (Timber)""),""5-2315"",IF(OR(B:B=""Spring Rocker Items""),""5-2310"",IF(OR(B:B=""SWING ASSEMBLIES ITEMS""),""5-2310""," & _
                              "IF(OR(B:B=""FITNESS TRACK ITEMS""),""5-2320"",IF(OR(B:B=""OUTDOOR FURNITURE ITEMS""),""5-2330"",IF(OR(B:B=""GYM EQUIPMENT ITEMS""),""5-2325"",IF(OR(B:B=""WEBSITE/CATALOGUE RANGE ITEMS""),""5-2310""," & _
                              "IF(OR(B:B=""SUMMIT EQUIPMENT RANGE ITEMS""),""5-2335"",IF(OR(B:B=""PARKFIT STRUCTURE ITEMS""),""5-2340"",IF(OR(B:B=""PARKFIT (BOLT DOWN) STRUCTURE ITEMS""),""5-2340""," & _
                              "IF(OR(B:B=""SINGLE STRUCTURE <$8,000 FA List""),""5-2310"",IF(OR(B:B=""ORBIT STRUCTURES""),""5-2345"",IF(OR(B:B=""ORBIT 2 STRUCTURES""),""5-2345""," & _
                              "IF(OR(B:B=""PLAY STRUCTURES""),""5-2310"","""")))))))))))))))))))))))))))))))))))))))))"
        
        Range("A14").AutoFill Destination:=Range("A14:A" & lastrow)
    
    
    
    
        With Range("A14:Q1284").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
    
    
        End With
        
        Range("A14:Q1284").Select
        Selection.Interior.Color = xlNone
        Selection.Font.Color = RGB(0, 0, 0)
        Selection.Font.Size = 10
        Selection.Font.Name = "Calibri"
        
    Columns(5).NumberFormat = "0.00"
    Columns(6).NumberFormat = "0.00"
    Columns(7).NumberFormat = "0.00"
    Columns(8).NumberFormat = "0.%"
    Columns(12).NumberFormat = "0.00"
    Columns(13).NumberFormat = "0%"
    Columns(15).NumberFormat = "0.00"
    Columns(16).NumberFormat = "0.00"
    Columns(17).NumberFormat = "0%"
    Range("E10").NumberFormat = "0"
    Range("F10").NumberFormat = "0"
    
    
    Range("A9:Z10").HorizontalAlignment = xlLeft
    Range("A14:D1284").HorizontalAlignment = xlLeft
    Range("A14:D1284").VerticalAlignment = xlCenter
    Range("E14:Q1284").HorizontalAlignment = xlRight
    Range("E14:Q1284").VerticalAlignment = xlCenter
    Range("A14:C1284").ShrinkToFit = True
    
    
    
    
    lRow = Range("F" & Rows.Count).End(xlUp).Row
    Set mr = Range("B14:Q" & lRow)
    For Each cell In mr
    If cell.Text = "Vic Price" Then
        Range("A" & cell.Row & ":Q" & cell.Row).Interior.Color = RGB(200, 100, 135)
        Range("c" & cell.Row & ":Q" & cell.Row).Font.Color = RGB(200, 100, 135)
        Range("C" & cell.Row & ":Q" & cell.Row).Font.Bold = False
        Range("B" & cell.Row & ":Q" & cell.Row).RowHeight = 15
        Range("B" & cell.Row & ":Q" & cell.Row).HorizontalAlignment = xlCenter
        Range("B" & cell.Row & ":Q" & cell.Row).VerticalAlignment = xlCenter
        
         Else         'Do nothing
         End If
         Next
       
    For Each cell In Range("I14:I1284")
            If Not IsEmpty(cell) Then
                If cell.Value = "No" Then
                    cell.EntireRow.Hidden = True
                End If
            End If
            
            If Not IsEmpty(cell) Then
                If cell.Value = "Y" Then
                    cell.EntireRow.Hidden = True
                End If
            End If
            
            If Not IsEmpty(cell) Then
                If cell.Value = "False" Then
                    cell.EntireRow.Hidden = True
                End If
            End If
            
            If Not IsEmpty(cell) Then
                If cell.Value = "True" Then
                    cell.EntireRow.Hidden = True
                End If
            End If
            
            If Not IsEmpty(cell) Then
                If cell.Value = "Report" Then
                    cell.EntireRow.Hidden = False
                End If
            End If
        Next
        
    
    
    Range("A9:Z10").HorizontalAlignment = xlLeft
    Range("A14:D1284").HorizontalAlignment = xlLeft
    Range("A14:D1284").VerticalAlignment = xlCenter
    Range("E14:Q1284").HorizontalAlignment = xlRight
    Range("A14:C1284").ShrinkToFit = True
    
    
    Columns("C:D").EntireColumn.Hidden = True
    Columns("I").EntireColumn.Hidden = True
    Columns("N").EntireColumn.Hidden = True
    
    
    lastrow = Range("D" & Rows.Count).End(xlUp).Row
    
    
    Application.ScreenUpdating = True
    
    
    
    
    End Sub
    TIA

  2. #2
    Board Regular
    Join Date
    Dec 2008
    Posts
    6,664
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA Macro Start to finish way to long

    Making the code shorter will not make much difference, it is the extra data being added to the sheets by the code that will increase the file size.

    Making it more efficient might help if there is something in the code that is bloating the file by making empty rows dirty (nothing stands out), but otherwise that would only help the code to run a bit faster.

    edit:- an empty workbook with the code added to it is only 21kb, the same empty workbook with no code is 8kb. 13kb is nothing in terms of workbook size.
    Last edited by jasonb75; Aug 31st, 2019 at 07:08 PM.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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