Cut/Paste Calculated Data Into Multiple Tabs

WcCannons

New Member
Joined
Dec 20, 2018
Messages
8
Hi,

I have a working version of code that is in need of some optimization and a few tweaks to make it function as intended. It contains no errors, but the output behavior is not as expected.

I have a Sheet called "Transaction Data" and "Digital Payments" that I am pasting data into each day. Those two tabs have some Vlookup functionality to match transactions between two databases, run a few calcs (This is handled in Macro1 to establish the fees I want to charge). Then output those charges that I relay to several clients in separate tabs (This is called Macro2, which is the item I post below). The output of the vlookup goes to the end of the data row. The row's data runs from "A" to "AE" and that individual row has no variability between rows (e.g. data wouldn't expand to "AJ" at any point).

2 main concerns:

1. The cut and move functionality is pretty slow, it takes a few mins to loop through when my data set exceeds hundreds of rows and into thousands... I haven't tried it with 10k plus records, but I know I will have to. I would like to improve the speed of the subs and maybe consolidate the code so I can add//subtract clients as they come.

2. The data that outputs to the individual tabs seems to be randomly placed into row. "Central" gets data in A1 as expected and fills down to the last row. "Falcon" and "Alfa" seem to randomly get inserted into a variable row. I would like the data in each respective tab to start at row 2 to allow for a header. Additionally, I would like to be able to drop new transactions into the existing spreadsheet, run the calcs to apply fees, and then run Macro2 at the end of each week, manually for now, to move the specific client transactions into the correct tab. The intent is to stack all of the transactions for each customer each month, then output each customer tab as a file to the respective customer.

Here is Macro 2 with it's respective private subs:


VBA Code:
Sub Macro2()

    MoveCentral
    MoveAlfa
    MoveFalcon
    FitData2
    FitData3
    FitData4
    
End Sub


Private Sub MoveCentral()
Dim Check As Range
Dim r As Long
Dim lastrow As Long
Dim lastrow2 As Long

Application.ScreenUpdating = False
lastrow = Worksheets("TransactionData").UsedRange.Rows.Count
lastrow2 = Worksheets("Central").UsedRange.Rows.Count
If lastrow2 = 1 Then lastrow2 = 0

    For r = lastrow To 2 Step -1
        If Range("E" & r).Value = "CENTRAL" Then
            Rows(r).Cut Destination:=Worksheets("Central").Range("A" & lastrow2 + 1)
            lastrow2 = lastrow2 + 1
            Else:
            End If
    Next r
Application.ScreenUpdating = True
End Sub


Private Sub MoveAlfa()
Dim Check As Range
Dim r As Long
Dim lastrow As Long

Dim lastrow3 As Long


Application.ScreenUpdating = False
lastrow = Worksheets("TransactionData").UsedRange.Rows.Count

lastrow3 = Worksheets("Alfa").UsedRange.Rows.Count


If lastrow3 = 1 Then lastrow3 = 0

    For r = lastrow To 2 Step -1

        If Range("E" & r).Value = "ALFA" Then
            Rows(r).Cut Destination:=Worksheets("Alfa").Range("A" & lastrow3 + 1)
            lastrow3 = lastrow3 + 1
            Else:

            End If
    Next r
Application.ScreenUpdating = True
End Sub

Private Sub MoveFalcon()
Dim Check As Range
Dim r As Long
Dim lastrow As Long
Dim lastrow4 As Long

Application.ScreenUpdating = False
lastrow = Worksheets("TransactionData").UsedRange.Rows.Count
lastrow4 = Worksheets("Falcon").UsedRange.Rows.Count
If lastrow4 = 1 Then lastrow4 = 0
    For r = lastrow To 2 Step -1
        If Range("E" & r).Value = "FALCON" Then
            Rows(r).Cut Destination:=Worksheets("Falcon").Range("A" & lastrow4 + 1)
            lastrow4 = lastrow4 + 1
            Else:
            End If
    Next r
Application.ScreenUpdating = True
End Sub

Private Sub FitData2()
    ' Target the worksheets in TransactionData to fit to their respective data widths.
        Worksheets("Central").Columns("A:AE").AutoFit

End Sub

Private Sub FitData3()
    ' Target the worksheets in TransactionData to fit to their respective data widths.
        Worksheets("Falcon").Columns("A:AE").AutoFit

End Sub

Private Sub FitData4()
    ' Target the worksheets in TransactionData to fit to their respective data widths.
        Worksheets("Alfa").Columns("A:AE").AutoFit

End Sub
 

Some videos you may like

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
51,152
Office Version
  1. 365
Platform
  1. Windows
You can replace the 3 move subs, with
VBA Code:
Sub WcCannons()
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Array("Central", "Alfa", "Falcon")
   Application.ScreenUpdating = False
   For i = 0 To UBound(Ary)
      With Worksheets("TransactionData")
         .Range("A1:AE1").AutoFilter 5, Ary(i)
         .AutoFilter.Range.Offset(1).Copy Sheets(Ary(i)).Range("E" & Rows.Count).End(xlUp).Offset(1, -4)
         .AutoFilter.Range.Offset(1).Delete
         .AutoFilterMode = False
      End With
   Next i
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,119,295
Messages
5,577,237
Members
412,777
Latest member
MrGray
Top