trjhtr

I have code that runs and does what I want it to do with the click of the command button, however when executing, it runs very slow.

The code grabs data from one sheet and inserts/formats it into another sheet in two separate tables that have been converted into range. I did this because I need to automatically update two different graphs with certain data.

I'm still new with VBA coding and any kind of direction or help to make the code run faster is appreciated or ways to remove unnecessary code since it is probably longer than it needs to be.

Public Sub Button1_Click() ' Update Button

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim lastRowPart As Long
Dim lastRowCW As Long
Dim lastRowQty As Long
Dim lastRowQtyLeft As Long
Dim lastRowDescrip As Long
Dim i, j, k As Integer
Dim IO As Worksheet: Set IO = Sheets("Inventory Overview")
Dim TD As Worksheet: Set TD = Sheets("Trend Data")

'1. Copies and formats data

lastRowPart = IO.Cells(Rows.count, "F").End(xlUp).Row
lastRowDescrip = IO.Cells(Rows.count, "G").End(xlUp).Row
lastRowQtyLeft = IO.Cells(Rows.count, "O").End(xlUp).Row
lastRowQty = IO.Cells(Rows.count, "I").End(xlUp).Row
lastRowCW = IO.Cells(Rows.count, "L").End(xlUp).Row

TD.Cells.UnMerge ' reset***

j = 2
k = 2
For i = 2 To lastRowCW
If IO.Cells(i, "L").Value = "Unknown" Then
 TD.Cells(j, "G").Value = IO.Cells(i, "L").Value
 TD.Cells(j, "H").Value = IO.Cells(i, "F").Value
 TD.Cells(j, "I").Value = IO.Cells(i, "I").Value
 TD.Cells(j, "J").Value = IO.Cells(i, "O").Value
 TD.Cells(j, "K").Value = IO.Cells(i, "G").Value
 j = j + 1
Else
 TD.Cells(k, "A").Value = IO.Cells(i, "L").Value
 TD.Cells(k, "B").Value = IO.Cells(i, "F").Value
 TD.Cells(k, "C").Value = IO.Cells(i, "I").Value
 TD.Cells(k, "D").Value = IO.Cells(i, "O").Value
 TD.Cells(k, "E").Value = IO.Cells(i, "G").Value
 k = k + 1
End If
Next

' Autofit
TD.range("B1:B" & lastRowPart).Columns.AutoFit
TD.range("E1:E" & lastRowDescrip).Columns.AutoFit
TD.range("H1:H" & lastRowPart).Columns.AutoFit
TD.range("K1:K" & lastRowDescrip).Columns.AutoFit

'2. Sort Cells
Dim LastRow As Long
LastRow = TD.Cells(Rows.count, 5).End(xlUp).Row

With TD.Sort ' sorts data from A to Z
 .SetRange TD.range("A2:E" & LastRow)
 .Header = xlGuess
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
End With

'3. Merge CW Cells
' rngMerge = range for parts reworked/left with known CW
' URngMerge = range for parts reported with unknown CW

Dim rngMerge As range, URngMerge As range, cell As range, lastRowMerge As Long, ULastRowMerge As Long
lastRowMerge = TD.Cells(Rows.count, 1).End(xlUp).Row
ULastRowMerge = TD.Cells(Rows.count, 7).End(xlUp).Row
Set rngMerge = TD.range("A1:A" & lastRowMerge)
Set URngMerge = TD.range("G1:G" & ULastRowMerge)

MergeAgain:
For Each cell In rngMerge
 If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
 range(cell, cell.Offset(1, 0)).Merge
 GoTo MergeAgain
End If
Next

MergeAgain2:
For Each cell In URngMerge
If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
 range(cell, cell.Offset(1, 0)).Merge
 GoTo MergeAgain2
End If
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Nice job, you dceclared all your variables and your variable names are pretty descriptive. One thing is

Dim i, j, k as Integer

This only has k as Integer, they other two are Variants. You need to type them all:

Dim i as Long, Dim j as Long, Dim k as Long

I went with Long type because integers are obsolete. According to msdn VBA silently converts all integers to long.

One nitpick is Dim LastRow As Long - Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names. So lastRow.

You also have rngMerge and UrngMerge - maybe be more descriptive in those names.

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

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("Trend Data") and instead just use TrendData.

I don't know what happened to your formatting, but your indenting isn't showing up as expected. It's good practice to indent all of your code that way Labels will stick out as obvious. You actually have 2 labels that are pretty well hidden.

Speaking of your labels

MergeAgain:
 For Each cell In rngMerge
 If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
 Range(cell, cell.Offset(1, 0)).Merge
 GoTo MergeAgain
 End If
 Next

MergeAgain2:
 For Each cell In URngMerge
 If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
 Range(cell, cell.Offset(1, 0)).Merge
 GoTo MergeAgain2
 End If
 Next

That's a strange way to do this looping.

For j = LastRow To startrow Step -1
 If (.Cells(j, col) = .Cells(j + 1, col)) And Not IsEmpty(.Cells(j, col)) Then .Range(.Cells(j, col), .Cells(j + 1, col)).Merge
Next

No reason to use labels if there's a better way to do it.

You see when you use a boolean function like IsEmpty, you don't need to test its value specifically because the If is looking for True or False already.

Speed

The only way to really gain speed here is to pull your data into arrays and do your operations on those, then spit out entire arrays to the sheet.

I'm not entirely sure of your goal with .Merge but they are your natural enemy. Trust me. It would be better to group the cells and .HorizontalAlignment = xlHAlignCenterAcrossSelection

You will get better quality answer if you post example data and/or screenshots or a download link with a sample workbook.

You need a RubberDuck. Download RubberDuck has an code formatting feature that is priceless (and much, much more!!). You should auto-format your code often. It will help you catch end code block mismatches as while as make you code more readable.

j and 'k' are not needed because they will both always equal i.

For i = 2 To lastRowCW
 If IO.Cells(i, "L").Value = "Unknown" Then
 j = j + 1
 Else
 k = k + 1
 End If
Next

Why is '.Header = xlGuess'?

With TD.Sort ' sorts data from A to Z
 .SetRange TD.Range("A2:E" & LastRow)
 .Header = xlGuess
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
End With

Assuming that the data has headers in .Range("A1:E1") use:

With TD.Sort ' sorts data from A to Z
 .SetRange TD.Range("A1:E" & LastRow)
 .Header = xlYes

GoTo statement are best reserved for error handling. Although GoTo MergeAgain makes the logic easier to follow it causes you to have to reiterate over the same cells multiple time. In my sample code below I demonstrate how to avoid the it using a range variable.

MergeAgain:
 For Each cell In rngMerge
 If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
 Range(cell, cell.Offset(1, 0)).Merge
 GoTo MergeAgain
 End If
 Next

Application.Calculation = xlCalculationManual could potentially speed up your code.

Reading data from an array instead of directly from the cells will provide a small increase in performance. Writing all the values in a single operation using an array will provide a massive increase in performance.

Avoid naming variables after existing built-in Objects.

At some point while writing your code you had a variable named range that had all lower case letters. I know this because range is improperly capitalized.
Adding Dim Range to the top of a code module and then deleting it will fix the capitalization throughout the project.

Consider breaking your code into multiple Subroutines. The fewer tasks that a Subroutines performs the easier it is to write, debug and modify.

There is no advantage to auto-fitting specific ranges.

' Autofit
TD.range("B1:B" & lastRowPart).Columns.AutoFit
TD.range("E1:E" & lastRowDescrip).Columns.AutoFit
TD.range("H1:H" & lastRowPart).Columns.AutoFit
TD.range("K1:K" & lastRowDescrip).Columns.AutoFit

Simple autofit the entire Columns.

TD.Range("B1,E1,H1,K1").EntireColumn.AutoFit

Refactored Code

Public Sub Button1_Click()
 Dim LastRow As Long
 Dim data As Variant
 Application.DisplayAlerts = False
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

 With ThisWorkbook.Worksheets("Trend Data")
 TrendDataClear
 data = getInventory
 .Range("A2").Resize(UBound(data, 1), UBound(data, 2)).Value = data
 TrendDataSort
 MergeCells 1, .Cells.Worksheet
 MergeCells "G", .Cells.Worksheet
 .Range("B1,E1,H1,K1").EntireColumn.AutoFit
 End With

 Application.DisplayAlerts = True
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

End Sub

Private Function getInventory() As Variant
 Dim i As Long, LastRow As Long
 Dim results As Variant

 With ThisWorkbook.Worksheets("Inventory Overview")
 LastRow = .Cells(Rows.Count, "L").End(xlUp).Row
 ReDim results(1 To LastRow - 1, 1 To 11)

 For i = 2 To LastRow
 If .Cells(i, "L").Value = "Unknown" Then
 results(i - 1, 7) = .Cells(i, "L").Value
 results(i - 1, 8) = .Cells(i, "F").Value
 results(i - 1, 9) = .Cells(i, "I").Value
 results(i - 1, 10) = .Cells(i, "O").Value
 results(i - 1, 11) = .Cells(i, "G").Value
 Else
 results(i - 1, 1) = .Cells(i, "L").Value
 results(i - 1, 2) = .Cells(i, "F").Value
 results(i - 1, 3) = .Cells(i, "I").Value
 results(i - 1, 4) = .Cells(i, "O").Value
 results(i - 1, 5) = .Cells(i, "G").Value
 End If
 Next
 End With

 getInventory = results
End Function

Private Sub MergeCells(vColumn As Variant, ws As Worksheet)
 Dim cell As Range, Target As Range
 With ws
 For Each cell In .Range(.Cells(2, vColumn), .Cells(.Rows.Count, vColumn).End(xlUp))
 If cell.Value = cell.Offset(1, 0).Value And IsEmpty(cell) = False Then
 If Target Is Nothing Then
 Set Target = Range(cell, cell.Offset(1))
 Else
 Set Target = Range(Target, cell.Offset(1))
 End If
 Else
 If Not Target Is Nothing Then
 Target.Merge
 Set Target = Nothing
 End If
 End If
 Next
 If Not Target Is Nothing Then Target.Merge
 End With
End Sub

Private Sub TrendDataClear()
 Dim Target As Range
 With ThisWorkbook.Worksheets("Trend Data")
 Set Target = Intersect(.UsedRange, .UsedRange.Offset(1))
 If Not Target Is Nothing Then
 Target.UnMerge
 Target.ClearContents
 End If
 End With
End Sub

Private Sub TrendDataSort()
 With ThisWorkbook.Worksheets("Trend Data")
 .Sort.SetRange .Range("A1:E1").Resize(Cells(Rows.Count, "L").End(xlUp).Row)
 With .Sort ' sorts data from A to Z
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
 End With
End Sub