VBA coding

A

Aberdham

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

I tried to combine sheets with different columns to a new sheet. and ran the code. but it says user-type not defined.

following link to the workbook: https://1drv.ms/x/s!Aqt4VfikFsyKdP__4BbJF1LMxlM

could anyone help me to run a debug?

Thank you in advance !
 
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

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
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? :eek: 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

J
  • Question
Automatically setting filters based upon user selection criteria
Replies
1
Views
166
John_w
J
Cubist
  • Solved
VBA - Application.Speech.Speak TroubleShoot
Replies
2
Views
101
Cubist
Cubist
M
  • Solved
link key from keyboard with button to run the code instead of click on the button
2 3
Replies
20
Views
275
Jaafar Tribak
Jaafar Tribak
M
  • Solved
Obtaining data from a cell reference contained within a cell.
Replies
3
Views
147
Peter_SSs
Peter_SSs
O
  • Solved
V / XLOOKUP issue
Replies
8
Views
191
Fluff
Fluff

Forum statistics

Threads
1,215,467
Messages
6,124,984
Members
449,201
Latest member
Lunzwe73

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