4
\$\begingroup\$

The code currently works as it should and seems to work dynamically as I need it to but I am pretty new to Excel so I think there is probably a better way to do some of the things I have set up. I also would like to make the code a bit prettier. 

'*******************************************************************************************************************************
'*******************This finds, copies, and moves the data to the correct sheets then formats them correctly********************
'*******************************************************************************************************************************

Sub Copy_Function_Data()
Dim Target As String
Dim X As Long
Dim Y As Long
Dim Target_2 As String
Dim Last_Row3 As Long
Dim Last_Column3 As Long
Dim Total_Count As Long
Dim Title_Column As Long
Dim Country_Column As String
Dim Row_Limit1, Row_Limit2 As Long
Dim Column_Limit1 As Long
Dim Row_Limit3 As Long
Dim Current_Sheet As String
Dim r As Range
Dim r2 As Range


Application.StatusBar = "Moving Data..."

Y = ActiveWorkbook.Worksheets("Calculations").Range("B3", Worksheets("Calculations").Range("B3").End(xlDown)).Rows.Count

For X = 1 To Y

Sheets("Calculations").Select
Target = Range("B2").Offset(X, 0)
ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "TempData"
Worksheets("TempData").Range("A1").Value = Target
ActiveSheet.Range("A1").Select
    Selection.Replace What:="Open Position - ", Replacement:=" ", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Target_2 = Worksheets("TempData").Range("A1")
ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = (Target_2)
Sheets("Raw Data").Select
Selection.AutoFilter
ActiveSheet.Range("$B$1:$Z$10000").AutoFilter Field:=5, Criteria1:= _
    (Target)
Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(Target_2).Select
Range("B50").Select
ActiveSheet.Paste
Total_Count = ActiveWorkbook.Worksheets(Target_2).Range("B50", Worksheets(Target_2).Range("B50").End(xlDown)).Rows.Count
Last_Row3 = Cells.Find(What:="*", _
            After:=Range("A1"), _
            LookAt:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Row
Last_Column3 = Cells.Find(What:="*", _
            After:=Range("A1"), _
            LookAt:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Column
Title_Column = Cells.Find(What:="Title", _
            After:=ActiveCell, _
            LookIn:=xlFormulas, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=False).Column
Country_Column = Cells.Find(What:="Country", _
            After:=ActiveCell, _
            LookIn:=xlFormulas, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=False).Column
ActiveWorkbook.Worksheets(Target_2).Range("R51", Worksheets(Target_2).Range("R51").End(xlDown)).Rows.Copy
Range("X50").Select
ActiveSheet.Paste
ActiveSheet.Range("$X$50:$X$10000").RemoveDuplicates Columns:=1, Header:= _
    xlNo
ActiveWorkbook.Worksheets(Target_2).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(Target_2).Sort.SortFields.Add Key:=Range("X50") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(Target_2).Sort
    .SetRange Range("X50:X10000")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Row_Limit1 = Worksheets(Target_2).Range("X:X").Cells.SpecialCells(xlCellTypeConstants).Count

If Row_Limit1 > 1 Then


ActiveWorkbook.Worksheets(Target_2).Range("X50", Worksheets(Target_2).Range("X50").End(xlDown)).Rows.Copy
Range("B3").Select
ActiveSheet.Paste

Else
ActiveWorkbook.Worksheets(Target_2).Range("X50", Worksheets(Target_2).Range("X50")).Copy
Range("B3").Select
ActiveSheet.Paste

End If

ActiveWorkbook.Worksheets(Target_2).Range("V51", Worksheets(Target_2).Range("V51").End(xlDown)).Rows.Copy
Range("Y50").Select
ActiveSheet.Paste
ActiveSheet.Range("$Y$50:$Y$10000").RemoveDuplicates Columns:=1, Header:= _
    xlNo
ActiveWorkbook.Worksheets(Target_2).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(Target_2).Sort.SortFields.Add Key:=Range("Y20") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(Target_2).Sort
    .SetRange Range("Y50:Y10000")
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Row_Limit2 = Worksheets(Target_2).Range("Y:Y").Cells.SpecialCells(xlCellTypeConstants).Count

If Row_Limit2 > 1 Then

ActiveWorkbook.Worksheets(Target_2).Range("Y50", Worksheets(Target_2).Range("Y50").End(xlDown)).Rows.Copy

ActiveSheet.Cells(2, 3).PasteSpecial Transpose:=True

Else
ActiveWorkbook.Worksheets(Target_2).Range("Y50", Worksheets(Target_2).Range("Y50")).Copy
Range("C2").Select
ActiveSheet.Cells(2, 3).PasteSpecial Transpose:=True

End If

Application.DisplayAlerts = False
Sheets("TempData").Delete
Application.DisplayAlerts = True


    Cells.Find(What:="Title", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        Range(Selection, Selection.End(xlDown)).Name = "Range1"
            Set r = Range("Range1")
    Cells.Find(What:="Country", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
        Range(Selection, Selection.End(xlDown)).Name = "Range2"
            Set r2 = Range("Range2")

Row_Limit1 = Worksheets(Target_2).Range("X:X").Cells.SpecialCells(xlCellTypeConstants).Count
Column_Limit1 = Worksheets(Target_2).Range("Y:Y").Cells.SpecialCells(xlCellTypeConstants).Count
With Worksheets(Target_2)
.Range(.Cells(3, 3), .Cells(Row_Limit1 + 2, Column_Limit1 + 2)).FormulaR1C1 = "=COUNTIFS(" & r.Address(ReferenceStyle:=xlR1C1) & ",RC2, " & r2.Address(ReferenceStyle:=xlR1C1) & ",R2C)"
.Range(.Cells(Row_Limit1 + 3, 3), .Cells(Row_Limit1 + 3, Column_Limit1 + 2)).FormulaR1C1 = "=SUM(R3C:R[-1]C)"
End With



Next X



 Application.StatusBar = False

End Sub
\$\endgroup\$
2
  • \$\begingroup\$ Could you provide a bit more detail about the problem your code is solving? Where is your data, What is your data, Do you have any control over where/how it is entered, Do you have any control over where/how it needs to be output? Are there any other specific requirements? \$\endgroup\$
    – Kaz
    Commented May 20, 2016 at 8:12
  • \$\begingroup\$ The data is in a sheet called "Raw Data" and it is currently in the same format each time the report is pulled. It comes from an Essbase pull. I have left instructions on the sheet to always ensure that the data lines up with the current template and that headers be normalized to the defaults. \$\endgroup\$
    – TonyP
    Commented May 20, 2016 at 15:44

1 Answer 1

Reset to default
3
\$\begingroup\$

The first thing I would address is using .Select or .Activate - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on StackOverflow addressing this - https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros.

First thing to do would be to give some variables to your worksheets

Dim calcSheet as worksheet
set calcSheet = Thisworkbook.sheets("Calculations")
Dim rawSheet as worksheet
set rawSheet = thisworkbook.sheets("raw data")
ThisWorkbook.Sheets.Add.Name = "tempdata"
dim tempSheet as worksheet
set tempsheet = thisworkbook.sheets("tempdata")

You get the idea. Now everytime you need to work with a selection, just specify the sheet object instead. Also, worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("mySheet") and instead just use mySheet.

So for example, this -

For X = 1 To Y
Sheets("Calculations").Select
Target = Range("B2").Offset(X, 0)

Becomes this

For x = 1 to Y
    Target = calcSheet.cells(2+x,2)

Easy peasy!

So this

Range("B1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets(Target_2).Select
Range("B50").Select
ActiveSheet.Paste

Becomes this simple 

Dim lastColumn As Long
Dim lastRow As Long
lastColumn = rawSheet.Cells(2, Columns.Count).End(xlToLeft).Column
lastRow = rawSheet.Cells(Rows.Count, 2).End(xlUp).Row
secondTarget.Range(Cells(50, 2), Cells(50 + lastRow, 2 + lastColumn)) = rawSheet.Range(Cells(1, 2), Cells(1 + lastRow, 2 + lastColumn)).Value

You'll notice I changed the method of finding the bounds. There is a standard way to find lastRow and lastColumn. That post explains why.

In this loop, you're creating a sheet everytime

For X = 1 To Y

Sheets("Calculations").Select
Target = Range("B2").Offset(X, 0)
ActiveWorkbook.Worksheets.Add

Make the sheet before the loop and if you need to, just clear it before the next iteration.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.