VBA coding

Sort by date Sort by votes
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

Thank you very much for posting back.

You are indeed correct and this works almost perfect !!

when the message box prompt, what should I type in? just 05/01/? and end date 05/31?

could we transfer to the different overview tab respectively?
 
Upvote 0

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

You enter 05/01/2018 and 05/31/2018, basically the first and last day of the month. Do you want to transfer the rows from Purchase Costs and Revenue Costs based on the number in column I of each sheet? Do you want the transferring to be done by the same macro? Please clarify in detail.
 
Upvote 0
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

Yes once the entries have been extracted to the purchase costs and revenue costs, I would like to have the respective rows transferred to the respective overview based on what column I indicated.

I have a slight issues with the date format. perhaps it is a different region that it should be modified as mm/dd/jjjj? (if I type in 05/01/2018, it would appear to be wrong format, but if I key in 05/01/, it would bring me to the end date prompt.
 
Upvote 0
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

I'll work on transferring the rows to the respective Overview sheets. Working with dates in Excel can be a tricky thing. What region are you in? Why "jjjj" and not "yyyy"?
 
Upvote 0
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

mumps said:
I'll work on transferring the rows to the respective Overview sheets. Working with dates in Excel can be a tricky thing. What region are you in? Why "jjjj" and not "yyyy"?
Click to expand...


It is indeed very tricky. I am in London. no clue why it Returns as jjjj instead of yyyy.

I have manage to revert the date to dd/mm/yyyy, hence no error Messages popping up indicating wrong Format. However, I don't seem to be able to retrieve the correct entries in the purchase costs sheet concerning the Dates. otherwise, all else work like a charm! :rolleyes: I am wondering if you had a Chance to try out for the code and get the "correct" results concerning the Dates?
 
Upvote 0
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

Try this macro. Make sure that you have all 72 Overview sheets in your workbook. Also in the Sales Report, "Data" sheet, row 81 has no WIP number in column P. You must make sure that there are no missing WIP numbers otherwise an error will be generated. Is there a situation where you must not have a WIP number?
Code: 
Sub CopyCols()
    Application.ScreenUpdating = False
    Dim USDsh As Worksheet, EURsh As Worksheet, DATAsh As Worksheet, PCsh As Worksheet, RCsh As Worksheet
    Set USDsh = Workbooks("Invoice_List_Purchase_2018.xlsx").Sheets("USD")
    Set EURsh = Workbooks("Invoice_List_Purchase_2018.xlsx").Sheets("EUR")
    Set DATAsh = Workbooks("Sales Report YTD.xlsx").Sheets("DATA")
    Set PCsh = ThisWorkbook.Sheets("Purchase Costs")
    Set RCsh = ThisWorkbook.Sheets("Revenue Costs")
    PCsh.UsedRange.Offset(1, 0).ClearContents
    RCsh.UsedRange.Offset(1, 0).ClearContents
    Dim beginDate As String
    Dim endDate As String
    Dim lastRow As Long
    Dim bottomA As Long, bottomB As Long, x As Long
    x = 2
    Dim WIP As Range
    Dim ws As Worksheet
    For Each ws In Workbooks("Invoice_List_Purchase_2018.xlsx").Sheets(Array("USD", "EUR"))
        If ws.Name = "USD" Then
            bottomA = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            Intersect(ws.Rows("2:" & bottomA), ws.Range("A:A,D:E,G:G,H:H")).Copy PCsh.Cells(PCsh.Rows.Count, "A").End(xlUp).Offset(1, 0)
            Intersect(ws.Rows("2:" & bottomA), ws.Range("L:L,N:N,S:S")).Copy PCsh.Cells(PCsh.Rows.Count, "G").End(xlUp).Offset(1, 0)
        ElseIf ws.Name = "EUR" Then
            bottomB = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
            Intersect(ws.Rows("2:" & bottomB), ws.Range("D:F")).Copy PCsh.Cells(PCsh.Rows.Count, "B").End(xlUp).Offset(1, 0)
            Intersect(ws.Rows("2:" & bottomB), ws.Range("G:G")).Copy PCsh.Range("F" & PCsh.Range("E" & PCsh.Rows.Count).End(xlUp).Row + 1)
            Intersect(ws.Rows("2:" & bottomB), ws.Range("K:K")).Copy PCsh.Range("G" & PCsh.Range("E" & PCsh.Rows.Count).End(xlUp).Row + 1)
            Intersect(ws.Rows("2:" & bottomB), ws.Range("S:S")).Copy PCsh.Range("I" & PCsh.Range("E" & PCsh.Rows.Count).End(xlUp).Row + 1)
        End If
    Next ws
    bottomA = DATAsh.Range("A" & DATAsh.Rows.Count).End(xlUp).Row
    Intersect(DATAsh.Rows("2:" & bottomA), DATAsh.Range("A:C")).Copy RCsh.Cells(RCsh.Rows.Count, "B").End(xlUp).Offset(1, 0)
    Intersect(DATAsh.Rows("2:" & bottomA), DATAsh.Range("I:I")).Copy RCsh.Cells(RCsh.Rows.Count, "E").End(xlUp).Offset(1, 0)
    Intersect(DATAsh.Rows("2:" & bottomA), DATAsh.Range("L:L")).Copy RCsh.Cells(RCsh.Rows.Count, "G").End(xlUp).Offset(1, 0)
    Intersect(DATAsh.Rows("2:" & bottomA), DATAsh.Range("P:P")).Copy RCsh.Cells(RCsh.Rows.Count, "I").End(xlUp).Offset(1, 0)
ReTry1:
    beginDate = InputBox("Please enter the start date in format mm/dd/yyyy", "Beginning date", Format(Now(), "mm/dd/yyyy"))
    If beginDate = "" Then
        MsgBox ("You have not entered a date.")
        PCsh.UsedRange.Offset(1, 0).ClearContents
        RCsh.UsedRange.Offset(1, 0).ClearContents
        Exit Sub
    End If
    If Format(beginDate, "mm/dd/yyyy") <> beginDate Then
        MsgBox "Wrong date format. Please enter in format mm/dd/yyyy.": GoTo ReTry1
    End If
ReTry2:
    endDate = InputBox("Please enter the end date in format mm/dd/yyyy", "End date", Format(Now(), "mm/dd/yyyy"))
    If endDate = "" Then
        MsgBox ("You have not entered a date.")
        PCsh.UsedRange.Offset(1, 0).ClearContents
        RCsh.UsedRange.Offset(1, 0).ClearContents
        Exit Sub
    End If
    If Format(endDate, "mm/dd/yyyy") <> endDate Then
        MsgBox "Wrong date format. Please enter in format mm/dd/yyyy.": GoTo ReTry2
    End If
    PCsh.Activate
    PCsh.Columns.AutoFit
    lastRow = PCsh.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    PCsh.Range("A1:K" & lastRow).AutoFilter Field:=1, Criteria1:="<>Material"
    If PCsh.Range("A2", Cells(PCsh.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        PCsh.Range("A2:K" & PCsh.Range("A" & PCsh.Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If PCsh.AutoFilterMode = True Then PCsh.AutoFilterMode = False
    PCsh.Range("A1:K" & lastRow).AutoFilter Field:=7, Criteria1:="<" & CDate(beginDate)
    If PCsh.Range("C2", Cells(PCsh.Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        PCsh.Range("A2:K" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If PCsh.AutoFilterMode = True Then PCsh.AutoFilterMode = False
    PCsh.Range("A1:K" & lastRow).AutoFilter Field:=7, Criteria1:=">" & CDate(endDate)
    If PCsh.Range("A2", Cells(PCsh.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        PCsh.Range("A2:K" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If PCsh.AutoFilterMode = True Then PCsh.AutoFilterMode = False
    RCsh.Activate
    RCsh.Columns.AutoFit
    RCsh.Range("A1:K" & lastRow).AutoFilter Field:=7, Criteria1:="<" & CDate(beginDate)
    If RCsh.Range("C2", Cells(RCsh.Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        RCsh.Range("A2:K" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If RCsh.AutoFilterMode = True Then RCsh.AutoFilterMode = False
    RCsh.Range("A1:K" & lastRow).AutoFilter Field:=7, Criteria1:=">" & CDate(endDate)
    If RCsh.Range("A2", Cells(RCsh.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        RCsh.Range("A2:K" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If RCsh.AutoFilterMode = True Then RCsh.AutoFilterMode = False
    For Each ws In Sheets
        If ws.Name Like "Overview*" Then
            ws.UsedRange.Offset(1, 0).ClearContents
        End If
    Next ws
    For Each ws In Sheets(Array("Purchase Costs", "Revenue Costs"))
        For Each WIP In ws.Range("I2:I" & ws.Range("I" & ws.Rows.Count).End(xlUp).Row)
            WIP.EntireRow.Copy Sheets("Overview WIP " & WIP.Value).Cells(Sheets("Overview WIP " & WIP.Value).Range("B" & Sheets("Overview WIP " & WIP.Value).Rows.Count).End(xlUp).Row + 1, 1)
        Next WIP
    Next ws
    Application.ScreenUpdating = True
End Sub
I look into the date problem.
 
Upvote 0
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

mumps said:
Try this macro. Make sure that you have all 72 Overview sheets in your workbook. Also in the Sales Report, "Data" sheet, row 81 has no WIP number in column P. You must make sure that there are no missing WIP numbers otherwise an error will be generated. Is there a situation where you must not have a WIP number?
Code: 
Sub CopyCols()
    Application.ScreenUpdating = False
    Dim USDsh As Worksheet, EURsh As Worksheet, DATAsh As Worksheet, PCsh As Worksheet, RCsh As Worksheet
    Set USDsh = Workbooks("Invoice_List_Purchase_2018.xlsx").Sheets("USD")
    Set EURsh = Workbooks("Invoice_List_Purchase_2018.xlsx").Sheets("EUR")
    Set DATAsh = Workbooks("Sales Report YTD.xlsx").Sheets("DATA")
    Set PCsh = ThisWorkbook.Sheets("Purchase Costs")
    Set RCsh = ThisWorkbook.Sheets("Revenue Costs")
    PCsh.UsedRange.Offset(1, 0).ClearContents
    RCsh.UsedRange.Offset(1, 0).ClearContents
    Dim beginDate As String
    Dim endDate As String
    Dim lastRow As Long
    Dim bottomA As Long, bottomB As Long, x As Long
    x = 2
    Dim WIP As Range
    Dim ws As Worksheet
    For Each ws In Workbooks("Invoice_List_Purchase_2018.xlsx").Sheets(Array("USD", "EUR"))
        If ws.Name = "USD" Then
            bottomA = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            Intersect(ws.Rows("2:" & bottomA), ws.Range("A:A,D:E,G:G,H:H")).Copy PCsh.Cells(PCsh.Rows.Count, "A").End(xlUp).Offset(1, 0)
            Intersect(ws.Rows("2:" & bottomA), ws.Range("L:L,N:N,S:S")).Copy PCsh.Cells(PCsh.Rows.Count, "G").End(xlUp).Offset(1, 0)
        ElseIf ws.Name = "EUR" Then
            bottomB = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
            Intersect(ws.Rows("2:" & bottomB), ws.Range("D:F")).Copy PCsh.Cells(PCsh.Rows.Count, "B").End(xlUp).Offset(1, 0)
            Intersect(ws.Rows("2:" & bottomB), ws.Range("G:G")).Copy PCsh.Range("F" & PCsh.Range("E" & PCsh.Rows.Count).End(xlUp).Row + 1)
            Intersect(ws.Rows("2:" & bottomB), ws.Range("K:K")).Copy PCsh.Range("G" & PCsh.Range("E" & PCsh.Rows.Count).End(xlUp).Row + 1)
            Intersect(ws.Rows("2:" & bottomB), ws.Range("S:S")).Copy PCsh.Range("I" & PCsh.Range("E" & PCsh.Rows.Count).End(xlUp).Row + 1)
        End If
    Next ws
    bottomA = DATAsh.Range("A" & DATAsh.Rows.Count).End(xlUp).Row
    Intersect(DATAsh.Rows("2:" & bottomA), DATAsh.Range("A:C")).Copy RCsh.Cells(RCsh.Rows.Count, "B").End(xlUp).Offset(1, 0)
    Intersect(DATAsh.Rows("2:" & bottomA), DATAsh.Range("I:I")).Copy RCsh.Cells(RCsh.Rows.Count, "E").End(xlUp).Offset(1, 0)
    Intersect(DATAsh.Rows("2:" & bottomA), DATAsh.Range("L:L")).Copy RCsh.Cells(RCsh.Rows.Count, "G").End(xlUp).Offset(1, 0)
    Intersect(DATAsh.Rows("2:" & bottomA), DATAsh.Range("P:P")).Copy RCsh.Cells(RCsh.Rows.Count, "I").End(xlUp).Offset(1, 0)
ReTry1:
    beginDate = InputBox("Please enter the start date in format mm/dd/yyyy", "Beginning date", Format(Now(), "mm/dd/yyyy"))
    If beginDate = "" Then
        MsgBox ("You have not entered a date.")
        PCsh.UsedRange.Offset(1, 0).ClearContents
        RCsh.UsedRange.Offset(1, 0).ClearContents
        Exit Sub
    End If
    If Format(beginDate, "mm/dd/yyyy") <> beginDate Then
        MsgBox "Wrong date format. Please enter in format mm/dd/yyyy.": GoTo ReTry1
    End If
ReTry2:
    endDate = InputBox("Please enter the end date in format mm/dd/yyyy", "End date", Format(Now(), "mm/dd/yyyy"))
    If endDate = "" Then
        MsgBox ("You have not entered a date.")
        PCsh.UsedRange.Offset(1, 0).ClearContents
        RCsh.UsedRange.Offset(1, 0).ClearContents
        Exit Sub
    End If
    If Format(endDate, "mm/dd/yyyy") <> endDate Then
        MsgBox "Wrong date format. Please enter in format mm/dd/yyyy.": GoTo ReTry2
    End If
    PCsh.Activate
    PCsh.Columns.AutoFit
    lastRow = PCsh.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    PCsh.Range("A1:K" & lastRow).AutoFilter Field:=1, Criteria1:="<>Material"
    If PCsh.Range("A2", Cells(PCsh.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        PCsh.Range("A2:K" & PCsh.Range("A" & PCsh.Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If PCsh.AutoFilterMode = True Then PCsh.AutoFilterMode = False
    PCsh.Range("A1:K" & lastRow).AutoFilter Field:=7, Criteria1:="<" & CDate(beginDate)
    If PCsh.Range("C2", Cells(PCsh.Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        PCsh.Range("A2:K" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If PCsh.AutoFilterMode = True Then PCsh.AutoFilterMode = False
    PCsh.Range("A1:K" & lastRow).AutoFilter Field:=7, Criteria1:=">" & CDate(endDate)
    If PCsh.Range("A2", Cells(PCsh.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        PCsh.Range("A2:K" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If PCsh.AutoFilterMode = True Then PCsh.AutoFilterMode = False
    RCsh.Activate
    RCsh.Columns.AutoFit
    RCsh.Range("A1:K" & lastRow).AutoFilter Field:=7, Criteria1:="<" & CDate(beginDate)
    If RCsh.Range("C2", Cells(RCsh.Rows.Count, "C").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        RCsh.Range("A2:K" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If RCsh.AutoFilterMode = True Then RCsh.AutoFilterMode = False
    RCsh.Range("A1:K" & lastRow).AutoFilter Field:=7, Criteria1:=">" & CDate(endDate)
    If RCsh.Range("A2", Cells(RCsh.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        RCsh.Range("A2:K" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If RCsh.AutoFilterMode = True Then RCsh.AutoFilterMode = False
    For Each ws In Sheets
        If ws.Name Like "Overview*" Then
            ws.UsedRange.Offset(1, 0).ClearContents
        End If
    Next ws
    For Each ws In Sheets(Array("Purchase Costs", "Revenue Costs"))
        For Each WIP In ws.Range("I2:I" & ws.Range("I" & ws.Rows.Count).End(xlUp).Row)
            WIP.EntireRow.Copy Sheets("Overview WIP " & WIP.Value).Cells(Sheets("Overview WIP " & WIP.Value).Range("B" & Sheets("Overview WIP " & WIP.Value).Rows.Count).End(xlUp).Row + 1, 1)
        Next WIP
    Next ws
    Application.ScreenUpdating = True
End Sub
I look into the date problem.
Click to expand...


I thought we would need a second coding for the overview transfer? :eeek: I will first update that and then run the code.
Has the code already considered the issue with the dates?
Thank you ever so much !!
 
Upvote 0
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

Hi Mumps,

I tried the code, which returns to me a run time error 9, subscript out of range,

and debugging to this statement:

Do I need to dim my overview wip as integer?

would that do the trick?
otherwise it is not transferring to the other tabs.


WIP.EntireRow.Copy Sheets("Overview WIP " & WIP.Value).Cells(Sheets("Overview WIP " & WIP.Value).Range("B" & Sheets("Overview WIP " & WIP.Value).Rows.Count).End(xlUp).Row + 1, 1)
 
Upvote 0
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

Do you have all 72 Overview sheets in the workbook? Are there any missing WIP numbers in column P?
 
Upvote 0
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

I have an extract of 10 wip and have all the 10 sheets open... and I had the blank shells replaced with 0.

would that work?~
 
Upvote 0
You must log in or register to reply here.

Similar threads

O
  • Question Question
Frustrating intermittent VBA error dialog telling me that "User-define Type Not Defined"
Replies
1
Views
241
Micron
M
A
  • Solved
VBA code to extract a table
Replies
5
Views
237
Anthony47
A
S
  • Solved
VBA - User defined type not defined error
Replies
4
Views
491
ssh99
S
itsMelly
  • Question Question
Help with checkbox macros
Replies
5
Views
306
MikeVol
MikeVol
N
  • Question Question
Assistant with VBA code from formula
Replies
8
Views
185
RoryA
RoryA

Forum statistics

Threads
1,223,911
Messages
6,175,337
Members
452,637
Latest member
Ezio2866

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