VBA help with Data transfer

A

Aberdham

Board Regular
Joined
Mar 8, 2018
Messages
163
Office Version
  1. 365
Platform
  1. Windows
Hey guys,

I am hoping to get some help with the VBA coding to transfer certain columns in 2 output sheets into one master file.

so basically in

· in 2018_sales file; exclude all rows that indicates “other” in column C
· If column V is CF in 2018_sales file , then refer to column W, transfer the data based on the starting date to the respective month. (i.e.: start: 1-5-2018 allocates to May-18 section; 1-6-2018 to Jun-18; retrospectively)
· If column V is AF, then refer to column W -1, transfer them to the current month.



2018_sales to Monthly-tracking file
A A
D B
E C
F D
J E
M F
--------------------------------------------------------------------------------------------------------------------------------

· in 2018_cost file, exclude all the rows in column A indicates “other & overhead”
· Transfer all the rows to the respective months based on the month indicated in column B (cost file)


2018_Cost to Monthly-tracking file
A A
D B
E C
F D
J E
M F
--------------------------------------------------------------------------------------------------------------------------------

I have uploaded the file in onedrive to be edited, and note that the expected results is indicated in the monthly-tracking file.

https://1drv.ms/w/s!Aqt4VfikFsyKgSccePa2WnBYMwii (input)
https://1drv.ms/x/s!Aqt4VfikFsyKgSUTPSv_ya__1xMn. (monthly-tracking)
https://1drv.ms/x/s!Aqt4VfikFsyKgSN_5CAtiL89Rimb. (2018_sales)
https://1drv.ms/x/s!Aqt4VfikFsyKgSGsxstu9sFVET4- (2018_costs)

Any help will be greatly appreciated.
Happy coding :)
 
Sort by date Sort by votes
Hey mumps, I have sent you the code in a message. Please check. Thank you
 
Upvote 0

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Make sure that all 3 workbooks are open. Place this macro in a standard module in the Monthly Tracking workbook and run it from there.

Code: 
Sub TransferData()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ldateto As Long, ldatefrom As Long, LastRow As Long, x As Long
    Dim fVisRow As Long, sMon As String
    Dim wsCost As Worksheet, wsSales As Worksheet, wbDest As Workbook
    Set wbDest = ActiveWorkbook
    Set wsCost = Workbooks("2018_Cost.xlsx").Sheets("Sheet2")
    Set wsSales = Workbooks("2018_Sales.xlsx").Sheets("Sheet2")
    LastRow = wsSales.Cells(Rows.Count, "W").End(xlUp).Row
    
    With wsSales
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .ListObjects("Table1").Range.AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="<>other"
        .ListObjects("Table1").Range.AutoFilter Field:=22, Criteria1:="CF"
        If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales Dec-17").Cells(wbDest.Sheets("Tutorial-Sales Dec-17").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("W4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .ListObjects("Table1").Range.AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="<>other"
            .ListObjects("Table1").Range.AutoFilter Field:=22, Criteria1:="CF"
            If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("W5", .Cells(.Rows.Count, "W").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("W" & fVisRow))), 3)
                Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("W4").AutoFilter
        Next x
        
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .ListObjects("Table1").Range.AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .ListObjects("Table1").Range.AutoFilter Field:=22, Criteria1:="AF"
        If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales Jan-18").Cells(wbDest.Sheets("Tutorial-Sales Jan-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("W4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .ListObjects("Table1").Range.AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .ListObjects("Table1").Range.AutoFilter Field:=22, Criteria1:="AF"
            If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("W5", .Cells(.Rows.Count, "W").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("W" & fVisRow)) + 1), 3)
                Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("W4").AutoFilter
        Next x
    End With
    
    With wsCost
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
        .ListObjects("Table1").Range.AutoFilter Field:=19, Criteria1:="CF"
        If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost Dec-17").Cells(wbDest.Sheets("Tutorial-Cost Dec-17").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("B4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
            .ListObjects("Table1").Range.AutoFilter Field:=19, Criteria1:="CF"
            If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("B5", .Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("B" & fVisRow))), 3)
                Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("B4").AutoFilter
        Next x
        
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
        .ListObjects("Table1").Range.AutoFilter Field:=19, Criteria1:="AF"
        If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost Jan-18").Cells(wbDest.Sheets("Tutorial-Cost Jan-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("B4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
            .ListObjects("Table1").Range.AutoFilter Field:=19, Criteria1:="AF"
            If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("B5", .Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("B" & fVisRow)) + 1), 3)
                Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("B4").AutoFilter
        Next x
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Make sure that all 3 workbooks are open. Place this macro in a standard module in the Monthly Tracking workbook and run it from there.

Code: 
Sub TransferData()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ldateto As Long, ldatefrom As Long, LastRow As Long, x As Long
    Dim fVisRow As Long, sMon As String
    Dim wsCost As Worksheet, wsSales As Worksheet, wbDest As Workbook
    Set wbDest = ActiveWorkbook
    Set wsCost = Workbooks("2018_Cost.xlsx").Sheets("Sheet2")
    Set wsSales = Workbooks("2018_Sales.xlsx").Sheets("Sheet2")
    LastRow = wsSales.Cells(Rows.Count, "W").End(xlUp).Row
    
    With wsSales
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .ListObjects("Table1").Range.AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="<>other"
        .ListObjects("Table1").Range.AutoFilter Field:=22, Criteria1:="CF"
        If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales Dec-17").Cells(wbDest.Sheets("Tutorial-Sales Dec-17").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("W4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .ListObjects("Table1").Range.AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:="<>other"
            .ListObjects("Table1").Range.AutoFilter Field:=22, Criteria1:="CF"
            If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("W5", .Cells(.Rows.Count, "W").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("W" & fVisRow))), 3)
                Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("W4").AutoFilter
        Next x
        
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .ListObjects("Table1").Range.AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .ListObjects("Table1").Range.AutoFilter Field:=22, Criteria1:="AF"
        If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales Jan-18").Cells(wbDest.Sheets("Tutorial-Sales Jan-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("W4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .ListObjects("Table1").Range.AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .ListObjects("Table1").Range.AutoFilter Field:=22, Criteria1:="AF"
            If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("W5", .Cells(.Rows.Count, "W").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("W" & fVisRow)) + 1), 3)
                Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("W4").AutoFilter
        Next x
    End With
    
    With wsCost
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
        .ListObjects("Table1").Range.AutoFilter Field:=19, Criteria1:="CF"
        If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost Dec-17").Cells(wbDest.Sheets("Tutorial-Cost Dec-17").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("B4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
            .ListObjects("Table1").Range.AutoFilter Field:=19, Criteria1:="CF"
            If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("B5", .Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("B" & fVisRow))), 3)
                Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("B4").AutoFilter
        Next x
        
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
        .ListObjects("Table1").Range.AutoFilter Field:=19, Criteria1:="AF"
        If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost Jan-18").Cells(wbDest.Sheets("Tutorial-Cost Jan-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("B4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
            .ListObjects("Table1").Range.AutoFilter Field:=19, Criteria1:="AF"
            If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("B5", .Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("B" & fVisRow)) + 1), 3)
                Intersect(.Rows("5:" & LastRow), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("B4").AutoFilter
        Next x
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
Click to expand...

Oh wow. you are amazing Mumps. I am wondering if there is a way to modify the .listobjects("Table1") to a selecon of data so that it won't slow down the process by including all the rows and coulmn?
 
Upvote 0
Try:
Code: 
Sub TransferData()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ldateto As Long, ldatefrom As Long, LastRowS As Long, LastRowC As Long, x As Long
    Dim fVisRow As Long, sMon As String
    Dim wsCost As Worksheet, wsSales As Worksheet, wbDest As Workbook
    Set wbDest = ActiveWorkbook
    Set wsCost = Workbooks("2018_Cost.xlsx").Sheets("Sheet2")
    Set wsSales = Workbooks("2018_Sales.xlsx").Sheets("Sheet2")
    LastRowS = wsSales.Cells(Rows.Count, "W").End(xlUp).Row
    LastRowC = wsCost.Cells(Rows.Count, "B").End(xlUp).Row
    
    With wsSales
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .Range("A4:X" & LastRowS).AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .Range("A4:X" & LastRowS).AutoFilter Field:=3, Criteria1:="<>other"
        .Range("A4:X" & LastRowS).AutoFilter Field:=22, Criteria1:="CF"
        If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales Dec-17").Cells(wbDest.Sheets("Tutorial-Sales Dec-17").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("W4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .Range("A4:X" & LastRowS).AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .Range("A4:X" & LastRowS).AutoFilter Field:=3, Criteria1:="<>other"
            .Range("A4:X" & LastRowS).AutoFilter Field:=22, Criteria1:="CF"
            If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("W5", .Cells(.Rows.Count, "W").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("W" & fVisRow))), 3)
                Intersect(.Rows("5:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("W4").AutoFilter
        Next x
        
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .Range("A4:X" & LastRowS).AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .Range("A4:X" & LastRowS).AutoFilter Field:=22, Criteria1:="AF"
        If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales Jan-18").Cells(wbDest.Sheets("Tutorial-Sales Jan-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("W4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .Range("A4:X" & LastRowS).AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .Range("A4:X" & LastRowS).AutoFilter Field:=22, Criteria1:="AF"
            If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("W5", .Cells(.Rows.Count, "W").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("W" & fVisRow)) + 1), 3)
                Intersect(.Rows("5:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Sales " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("W4").AutoFilter
        Next x
    End With
    
    With wsCost
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .Range("A4:U" & LastRowC).AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .Range("A4:U" & LastRowC).AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
        .Range("A4:U" & LastRowC).AutoFilter Field:=19, Criteria1:="CF"
        If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost Dec-17").Cells(wbDest.Sheets("Tutorial-Cost Dec-17").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("B4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .Range("A4:U" & LastRowC).AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .Range("A4:U" & LastRowC).AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
            .Range("A4:U" & LastRowC).AutoFilter Field:=19, Criteria1:="CF"
            If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("B5", .Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("B" & fVisRow))), 3)
                Intersect(.Rows("5:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("B4").AutoFilter
        Next x
        
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .Range("A4:U" & LastRowC).AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .Range("A4:U" & LastRowC).AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
        .Range("A4:U" & LastRowC).AutoFilter Field:=19, Criteria1:="AF"
        If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
            Intersect(.Rows("5:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost Jan-18").Cells(wbDest.Sheets("Tutorial-Cost Jan-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("B4").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .Range("A4:U" & LastRowC).AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .Range("A4:U" & LastRowC).AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>overhead"
            .Range("A4:U" & LastRowC).AutoFilter Field:=19, Criteria1:="AF"
            If .Range("S1:S" & .Range("S" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 4 Then
                fVisRow = .Range("B5", .Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("B" & fVisRow)) + 1), 3)
                Intersect(.Rows("5:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Cells(wbDest.Sheets("Tutorial-Cost " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("B4").AutoFilter
        Next x
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
In the Month-end file, some of the "Sales" sheets have an "l" at the end of the name. Please correct all these sheets so they read "Sales" and not "Salesl". You will have to add the Sales and Cost sheets for the month of September as well: "Lease Sales Sep-18" and "Lease Cost Sep-18". You may also have to add the sheets for the appropriate months for 2017. Try this macro:
Code: 
Sub TransferData()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim ldateto As Long, ldatefrom As Long, LastRowB As Long, LastRowS As Long, LastRowC As Long, x As Long
    Dim fVisRow As Long, sMon As String
    Dim wsUSD As Worksheet, wsSales As Worksheet, wbDest As Workbook
    Set wbDest = ActiveWorkbook
    Set wsUSD = Workbooks("Invoice List_Purchases MLS_2018.xlsm").Sheets("USD")
    Set wsSales = Workbooks("Invoice List_Revenues MLS_2018.xlsm").Sheets("Sales Lease Invoice $")
    LastRowS = wsSales.Cells(wsSales.Rows.Count, "W").End(xlUp).Row
    LastRowB = wsUSD.Cells(wsUSD.Rows.Count, "B").End(xlUp).Row
    
    With wsSales
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .Range("A3:AB" & LastRowS).AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .Range("A3:AB" & LastRowS).AutoFilter Field:=3, Criteria1:="<>down payment request"
        .Range("A3:AB" & LastRowS).AutoFilter Field:=22, Criteria1:="LF"
        If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 3 Then
            Intersect(.Rows("4:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Lease Sales Dec-17").Cells(wbDest.Sheets("Lease Sales Dec-17").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("W3").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .Range("A3:AB" & LastRowS).AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .Range("A3:AB" & LastRowS).AutoFilter Field:=3, Criteria1:="<>down payment request"
            .Range("A3:AB" & LastRowS).AutoFilter Field:=22, Criteria1:="LF"
            If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 3 Then
                fVisRow = .Range("W4", .Cells(.Rows.Count, "W").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("W" & fVisRow))), 3)
                Intersect(.Rows("4:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Lease Sales " & sMon & "-18").Cells(wbDest.Sheets("Lease Sales " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("W3").AutoFilter
        Next x
        
        ldatefrom = DateSerial(2017, 12, 1)
        ldateto = DateSerial(2017, 12 + 1, 0)
        .Range("A3:AB" & LastRowS).AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
        .Range("A3:AB" & LastRowS).AutoFilter Field:=22, Criteria1:="UF"
        If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 3 Then
            Intersect(.Rows("4:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Lease Sales Jan-18").Cells(wbDest.Sheets("Lease Sales Jan-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
        .Range("W3").AutoFilter
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .Range("A3:AB" & LastRowS).AutoFilter Field:=23, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .Range("A3:AB" & LastRowS).AutoFilter Field:=22, Criteria1:="UF"
            If .Range("V1:V" & .Range("V" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 3 Then
                fVisRow = .Range("W4", .Cells(.Rows.Count, "W").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("W" & fVisRow)) + 1), 3)
                Intersect(.Rows("4:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Lease Sales " & sMon & "-18").Cells(wbDest.Sheets("Lease Sales " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("W3").AutoFilter
        Next x
    End With
    
    With wsUSD
        For x = 1 To 12
            ldatefrom = DateSerial(2017, x, 1)
            ldateto = DateSerial(2017, x + 1, 0)
            .Range("A2:V" & LastRowB).AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .Range("A2:V" & LastRowB).AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>material"
            If .Range("B1:B" & .Range("B" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 2 Then
                fVisRow = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("B" & fVisRow))), 3)
                Intersect(.Rows("3:" & LastRowB), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Lease Cost " & sMon & "-17").Cells(wbDest.Sheets("Lease Cost" & sMon & "-17").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("B2").AutoFilter
        Next x
        
        For x = 1 To 8
            ldatefrom = DateSerial(2018, x, 1)
            ldateto = DateSerial(2018, x + 1, 0)
            .Range("A2:V" & LastRowB).AutoFilter Field:=2, Criteria1:=">=" & ldatefrom, Operator:=xlAnd, Criteria2:="<=" & ldateto
            .Range("A2:V" & LastRowB).AutoFilter Field:=1, Criteria1:="<>other", Operator:=xlAnd, Criteria2:="<>material"
            If .Range("B1:B" & .Range("B" & .Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Cells.Count > 2 Then
                fVisRow = .Range("B3", .Cells(.Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row
                sMon = Left(MonthName(Month(.Range("B" & fVisRow))), 3)
                Intersect(.Rows("3:" & LastRowB), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Lease Cost " & sMon & "-18").Cells(wbDest.Sheets("Lease Cost " & sMon & "-18").Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
            .Range("B2").AutoFilter
        Next x
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi Mumps,

Thank you very much for the modified code! I tried to run the code. it gave me error subscript out of range, pointing at Intersect(.Rows("4:" & LastRowS), .Range("A:A,D:F,J:J,M:M")).SpecialCells(xlCellTypeVisible).Copy wbDest.Sheets("Lease Sales Dec-17").Cells(wbDest.Sheets("Lease Sales Dec-17").Rows.Count, "A").End(xlUp).Offset(1, 0) this line.
Could you please advise and help me to debug the code?
Thank you.
 
Last edited:
Upvote 0

Hi Mumps,

I think I have solved the previous error,now I am having error "13" type mismatch. pointing at sMon = Left(MonthName(Month(.Range("W" & fVisRow))), 3)

Could you please take a look? Thank you
 
Upvote 0
If column V contains UF, then It should paste to the+1 month in the month-end file. in the purchase file, USD sheet, from row 666, columnsS,T,U are manual input, in column F I use a formula to nest all the cells. Is that possible to include “LF” and “UF” (Itis not necessary though)
Once it is done, is itpossible to make a comparison that each ESN within the same month have 1 leasefee and/or 1 use fee in the sales tab in the month end file that matches the respectivelease fee and/or use fee in the cost tab? (please note: if it is not used/idle,then it doesn’t generate use fee). or isthis better to use formula to match?
Click to expand...

I'm still not clear what you mean by "the+1 month". If the month is June, do you want the data copied to May or to July for the "UF" values? Before we look at any other changes, you have to get the macro to work for you. Make sure that all the necessary sheets exist and that you corrected the sheet names as I have explained. Try closing all your files and re-opening them and then try the macro. It works properly for me without any errors. Please respond in this thread rather than by PM. It makes things easier.
 
Upvote 0
mumps said:
I'm still not clear what you mean by "the+1 month".
If the month is June, do you want the data copied to May or to July for the "UF" values?
Click to expand...
Yes that's correct.
Before we look at any other changes, you have to get the macro to work for you. Make sure that all the necessary sheets exist and that you corrected the sheet names as I have explained. Try closing all your files and re-opening them and then try the macro. It works properly for me without any errors. Please respond in this thread rather than by PM. It makes things easier.
Click to expand...

Thank you!
 
Upvote 0
You must log in or register to reply here.

Similar threads

Yecart77
  • Solved
Data consolidation within a table
Replies
4
Views
157
Yecart77
Yecart77
Yecart77
  • Question
Formula working on first row but not subsequent rows
Replies
1
Views
90
awoohaw
awoohaw
C
  • Solved
Subscript out of range error
2
Replies
12
Views
526
Domenic
D
M
  • Solved
Moving Data From Columns To Rows
Replies
6
Views
160
Fluff
Fluff
S
  • Solved
Shortcut to show/hide certain columns?
2
Replies
15
Views
201
Micron
M

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,093
Latest member
dbomb1414

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