How to improve VBA code?

D

dbravo

New Member
Joined
Aug 5, 2014
Messages
27
Hello, i am a beginner in the VBA world so i am still finding ways to improve. Here i have a code (can't upload file due to security) that first adds 3 columns for each company , puts each sum in an array, then pastes all columns of the top 5 sum of 3 columns of the companies in another workbook. It does this (copies) for 3 different sheets and pastes in 1 sheet. Basically it is accounts receivable for three different markets and i search one workbook that has the data, sum the over 90 days for each market and paste the total values to another workbook which we then send out. If there is some ways to make this faster? Use different commands? or such i would greatly appreciate it. The macro works but i know there are more efficient ways to make this happen..

Sorry that there is no file

Thank you all.

Code: 
Sub top()Application.ScreenUpdating = False
Dim counts(0 To 500)
Dim counts2(0 To 500)
Dim counts3(0 To 500)


Dim ifer As Integer


stopped = False
UserForm.Show


If stopped Then Exit Sub


Workbooks(namess).Sheets(1).Activate


With ActiveSheet




'GBP
For Each Cell In Workbooks(namess).Sheets(1).Range("B:B")
    If Not IsEmpty(Cell.Value) Then
    counts(ifer) = WorksheetFunction.Sum(Workbooks(namess).Sheets(1).Range(Cells(Cell.Row, 8), (Cells(Cell.Row, 11))))
    ifer = ifer + 1
    End If
Next Cell


For Each Cell In Workbooks(namess).Sheets(1).Range("B:B")
    If Not IsEmpty(Cell.Value) Then
        Select Case WorksheetFunction.Sum(Range(Cells(Cell.Row, 8), (Cells(Cell.Row, 11))))
        
            Case WorksheetFunction.Large(counts, 1)
            Workbooks(namess).Sheets(1).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C27").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(1).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D27").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L27").Value = WorksheetFunction.Large(counts, 1)
            


            Case WorksheetFunction.Large(counts, 2)
            Workbooks(namess).Sheets(1).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C28").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(1).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D28").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L28").Value = WorksheetFunction.Large(counts, 2)




            Case WorksheetFunction.Large(counts, 3)
            Workbooks(namess).Sheets(1).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C29").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(1).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D29").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L29").Value = WorksheetFunction.Large(counts, 3)




            Case WorksheetFunction.Large(counts, 4)
            Workbooks(namess).Sheets(1).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C30").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(1).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D30").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L30").Value = WorksheetFunction.Large(counts, 4)




            Case WorksheetFunction.Large(counts, 5)
            Workbooks(namess).Sheets(1).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C31").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(1).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D31").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L31").Value = WorksheetFunction.Large(counts, 5)




        End Select
    End If
Next Cell


End With




Workbooks(namess).Sheets(2).Activate


With ActiveSheet


''LgMkt
For Each Cell In Workbooks(namess).Sheets(2).Range("B:B")
    If Not IsEmpty(Cell.Value) Then
    counts2(ifer) = WorksheetFunction.Sum(Range(Cells(Cell.Row, 8), (Cells(Cell.Row, 11))))
    ifer = ifer + 1
    End If
Next Cell


For Each Cell In Workbooks(namess).Sheets(2).Range("B:B")
    If Not IsEmpty(Cell.Value) Then
        Select Case WorksheetFunction.Sum(Range(Cells(Cell.Row, 8), (Cells(Cell.Row, 11))))
        
            Case WorksheetFunction.Large(counts2, 1)
            Workbooks(namess).Sheets(2).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C33").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(2).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D33").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L33").Value = WorksheetFunction.Large(counts2, 1)
            


            Case WorksheetFunction.Large(counts2, 2)
            Workbooks(namess).Sheets(2).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C34").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(2).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D34").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L34").Value = WorksheetFunction.Large(counts2, 2)




            Case WorksheetFunction.Large(counts2, 3)
            Workbooks(namess).Sheets(2).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C35").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(2).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D35").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L35").Value = WorksheetFunction.Large(counts2, 3)




            Case WorksheetFunction.Large(counts2, 4)
            Workbooks(namess).Sheets(2).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C36").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(2).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D36").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L36").Value = WorksheetFunction.Large(counts2, 4)




            Case WorksheetFunction.Large(counts2, 5)
            Workbooks(namess).Sheets(2).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C37").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(2).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D37").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L37").Value = WorksheetFunction.Large(counts2, 5)




        End Select
    End If
Next Cell


End With


Workbooks(namess).Sheets(4).Activate


With ActiveSheet


'MM Market
For Each Cell In Workbooks(namess).Sheets(4).Range("B:B")
    If Not IsEmpty(Cell.Value) Then
    counts3(ifer) = WorksheetFunction.Sum(Range(Cells(Cell.Row, 8), (Cells(Cell.Row, 11))))
    ifer = ifer + 1
    End If
Next Cell


For Each Cell In Workbooks(namess).Sheets(4).Range("B:B")
    If Not IsEmpty(Cell.Value) Then
        Select Case WorksheetFunction.Sum(Range(Cells(Cell.Row, 8), (Cells(Cell.Row, 11))))
        
            Case WorksheetFunction.Large(counts3, 1)
            Workbooks(namess).Sheets(4).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C39").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(4).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D39").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L39").Value = WorksheetFunction.Large(counts3, 1)
            


            Case WorksheetFunction.Large(counts3, 2)
            Workbooks(namess).Sheets(4).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C40").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(4).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D40").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L40").Value = WorksheetFunction.Large(counts3, 2)




            Case WorksheetFunction.Large(counts3, 3)
            Workbooks(namess).Sheets(4).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C41").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(4).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D41").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L41").Value = WorksheetFunction.Large(counts3, 3)




            Case WorksheetFunction.Large(counts3, 4)
            Workbooks(namess).Sheets(4).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C42").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(4).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D42").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L42").Value = WorksheetFunction.Large(counts3, 4)




            Case WorksheetFunction.Large(counts3, 5)
            Workbooks(namess).Sheets(4).Cells(Cell.Row, 3).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("C43").PasteSpecial xlPasteValues
            Workbooks(namess).Sheets(4).Range(Cells(Cell.Row, 5), Cells(Cell.Row, 12)).Copy
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("D43").PasteSpecial xlPasteValues
            ThisWorkbook.Sheets("AR-Top 5 >90 Days").Range("L43").Value = WorksheetFunction.Large(counts3, 5)




        End Select
    End If
Next Cell


End With




Application.ScreenUpdating = True
ThisWorkbook.Activate






End Sub
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
You must log in or register to reply here.

Similar threads

S
  • Question
New record from multi sheets to one sheet
Replies
0
Views
203
spmatrix
S
H
  • Question
VBA to Create a speaker object
Replies
0
Views
108
hsandeep
H
C
  • Question
Vba extend my range to 25 builds from 2
Replies
1
Views
219
Micron
M
L
  • Solved
Would like to make edits to VBA Calendar Code
Replies
8
Views
397
Legacy 352679
L
T
  • Solved
VBA code cannot find sheet name
2
Replies
11
Views
174
jolivanes
jolivanes

Forum statistics

Threads
1,214,877
Messages
6,122,051
Members
449,064
Latest member
scottdog129

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