# Grab data from one sheet and insert/format it into another sheet

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.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)
.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.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.

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

• Thank you! I am merging cells because I am trying to auto update two different clustered column graphs. For example, one graph will show a quantity of parts that have been worked on and how many are left to be reworked per calendar week. So the different parts and calendar week will show on the x axis and quantity on the y axis. Mar 21 '18 at 13:04

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


With TD.Sort  ' sorts data from A to Z
.SetRange TD.Range("A2:E" & LastRow)
.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)


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.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.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

• I'm not sure why it would throw an error, unless the UsedRange returning all the rows. Do you have any formats that you want to preserve? Is there a header rows?