VBA Macro Start to finish way to long

S

slohman

Board Regular
Joined
Mar 31, 2012
Messages
110
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
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
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:
Upvote 0
You must log in or register to reply here.

Similar threads

Ottsel
  • Question Question
Create & Secure PDFS with Excel
Replies
3
Views
273
John_w
J
B
  • Solved
Use Sheet1:D5 to find matching cell in Sheet2 Column A:A, and select cell (or row)
Replies
1
Views
429
brianv
B
G
  • Solved
Skip Row When Column Word Meet
2
Replies
14
Views
389
Peter_SSs
Peter_SSs
C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
372
NdNoviceHlp
NdNoviceHlp
M
  • Question Question
Split Excel Workbook to separate .xlsx files for each unique value in Column A, also copy worksheet for Drop Down reference
Replies
9
Views
486
Alex Blakenburg
A

Forum statistics

Threads
1,224,824
Messages
6,181,186
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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