VBA coding

Re: Need help with VBA coding

Because of the prompts involved, I've had to add error checking code to validate the data entered when prompted. Start by opening a new blank workbook and save it as "CombinedData.xlsx". Sheet1 of this workbook will be the destination sheet. Then copy/paste the following macro in a regular module in the source workbook and run it from there. Make sure both workbooks are open before running the macro.
Code:
Sub CopyCols()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook
    Set srcWB = ThisWorkbook
    Dim desWS As Worksheet
    Set desWS = Workbooks("CombinedData.xlsx").Sheets("Sheet1")
    desWS.UsedRange.ClearContents
    Dim beginDate As String
    Dim endDate As String
    Dim lastRow As Long
    Dim bottomA As Long
    Dim ws As Worksheet
    desWS.Range("A1:H1") = Array("Course Type", "Invoice No.", "Lecturer", "Description", "Net Amount", "Invoice Date", "Exchange", "Classification")
    For Each ws In srcWB.Sheets(Array("Purchase  USD", "Purchase EUR"))
        If ws.Name = "Purchase  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,K:L,N:N,S:S")).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
        ElseIf ws.Name = "Purchase EUR" Then
            bottomA = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
            Intersect(ws.Rows("2:" & bottomA), ws.Range("A:A,D:F,J:K,M:M,S:S")).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
        End If
    Next ws
   [COLOR=#ff0000] response[/COLOR] = InputBox("Please enter the search criteria for the course type material.")
    If WorksheetFunction.CountIf(desWS.Range("A:A"), response) = 0 Then
        MsgBox ("Filter criteria not found in Column A.  Please try again.")
        desWS.UsedRange.ClearContents
        Exit Sub
    End If
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.")
        desWS.UsedRange.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.")
        desWS.UsedRange.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
    desWS.Activate
    desWS.Columns.AutoFit
    lastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    desWS.Range("A1:H" & lastRow).AutoFilter Field:=1, Criteria1:="<>" & response
    If desWS.Range("A2", Cells(desWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        desWS.Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If desWS.AutoFilterMode = True Then desWS.AutoFilterMode = False
    desWS.Range("A1:H" & lastRow).AutoFilter Field:=6, Criteria1:="<" & CDate(beginDate)
    If desWS.Range("A2", Cells(desWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        desWS.Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If desWS.AutoFilterMode = True Then desWS.AutoFilterMode = False
    desWS.Range("A1:H" & lastRow).AutoFilter Field:=6, Criteria1:=">" & CDate(endDate)
    If desWS.Range("A2", Cells(desWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
        desWS.Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    If desWS.AutoFilterMode = True Then desWS.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

Thank you very much for taking the time and effort to write the code:-) I followed the instruction and change the format of the date and have them both open while I ran the code. but it returned as: compile error: variable not defined and indicated to response ( highlighted in red). I am wondering what would be the reason for such error?
 
Upvote 0

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Re: Need help with VBA coding

We have basically walked through the part by extracting specific columns from the invoice list purchase 2018 (USD & EUR) to the material development purchase sheet. I am not quite sure why I get compile error, variables not define in the response row (within the code), there is a catch since some of the invoice are in euro and in the material development file. All the set ups have 2 different currencies, so I would like to skip the USD column and transfer to the euro column. Once that’s concluded, I would like to have the respective data from sale report YTD transferred to the revenue costs sheet in Material development (similar method) but I don’t know how to skip columns? The autofilter criteria is marked in red within the sheets. When that’s done, I would like to have them transfer to the respective overview WIP sheet (70 WIPS) based on which WIP they are allocated to. Please let me know if you need further clarification.
The data in your actual files has a completely different setup from the sample you posted so we will have to start all over again one step at a time. You want to copy specific columns from the invoice list purchase 2018 (USD & EUR) to the material development purchase sheet. Which columns from the USD and EUR sheets in the invoice list purchase 2018 do you want to copy to the material development purchase sheet? What do you mean by:
I would like to skip the USD column and transfer to the euro column
Please be very detailed in your description, referring to specific cell, rows, columns and sheets. Let's stop there for now and try to get this part done.
 
Upvote 0
Re: Need help with VBA coding

The data in your actual files has a completely different setup from the sample you posted so we will have to start all over again one step at a time. You want to copy specific columns from the invoice list purchase 2018 (USD & EUR) to the material development purchase sheet. Which columns from the USD and EUR sheets in the invoice list purchase 2018 do you want to copy to the material development purchase sheet? What do you mean by: Please be very detailed in your description, referring to specific cell, rows, columns and sheets. Let's stop there for now and try to get this part done.

Hi Mumps,

Thank you for getting back to me, so here it goes:

(From USD - MDP: A-A; D-B; E-C; G-D; H-E; (F blank); L-G; N-H; S-I)
(From EUR - MDP: [TABLE="width: 197"]
<tbody>[TR]
[TD][TABLE="width: 400"]
<tbody>[TR]
[TD]A (blank); D - B; E - C; F - D; E (blank) G - F; K - G; M - H ; S - I)

Let me know if you Need further clarifications.
[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
[/TD]
[/TR]
</tbody><colgroup><col></colgroup>[/TABLE]
 
Upvote 0
Re: Need help with VBA coding

The data in your actual files has a completely different setup from the sample you posted so we will have to start all over again one step at a time. You want to copy specific columns from the invoice list purchase 2018 (USD & EUR) to the material development purchase sheet. Which columns from the USD and EUR sheets in the invoice list purchase 2018 do you want to copy to the material development purchase sheet? What do you mean by: Please be very detailed in your description, referring to specific cell, rows, columns and sheets. Let's stop there for now and try to get this part done.


I was able to use the respective code by declaring it. but got stuck with the date.

I checked the format it seems to be dd-mm-jjjj which I modify and still got error message that I don't have the right format entered.

:eeek:

Sub CopyCols()
Application.ScreenUpdating = False
Dim srcWB As Workbook
Set srcWB = ThisWorkbook
Dim desWS As Worksheet
Set desWS = Workbooks("CombinedData.xlsx").Sheets("Sheet1")
desWS.UsedRange.ClearContents
Dim beginDate As String
Dim endDate As String
Dim lastRow As Long
Dim bottomA As Long
Dim ws As Worksheet
desWS.Range("A1:H1") = Array("Course Type", "Invoice No.", "Lecturer", "Description", "Net Amount", "Invoice Date", "Exchange", "Classification")
For Each ws In srcWB.Sheets(Array("Purchase USD", "Purchase EUR"))
If ws.Name = "Purchase 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,K:L,N:N,S:S")).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
ElseIf ws.Name = "Purchase EUR" Then
bottomA = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Intersect(ws.Rows("2:" & bottomA), ws.Range("A:A,D:F,J:K,M:M,S:S")).Copy desWS.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0)
End If
Next ws
Dim response as integer
response = InputBox("Please enter the search criteria for the course type material.")
If WorksheetFunction.CountIf(desWS.Range("A:A"), response) = 0 Then
MsgBox ("Filter criteria not found in Column A. Please try again.")
desWS.UsedRange.ClearContents
Exit Sub
End If
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.")
desWS.UsedRange.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.")
desWS.UsedRange.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
desWS.Activate
desWS.Columns.AutoFit
lastRow = desWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
desWS.Range("A1:H" & lastRow).AutoFilter Field:=1, Criteria1:="<>" & response
If desWS.Range("A2", Cells(desWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
desWS.Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
If desWS.AutoFilterMode = True Then desWS.AutoFilterMode = False
desWS.Range("A1:H" & lastRow).AutoFilter Field:=6, Criteria1:="<" & CDate(beginDate)
If desWS.Range("A2", Cells(desWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
desWS.Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
If desWS.AutoFilterMode = True Then desWS.AutoFilterMode = False
desWS.Range("A1:H" & lastRow).AutoFilter Field:=6, Criteria1:=">" & CDate(endDate)
If desWS.Range("A2", Cells(desWS.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells(1, 1).Row > 1 Then
desWS.Range("A2:H" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
If desWS.AutoFilterMode = True Then desWS.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Re: Need help with VBA coding

Should be
Code:
Dim response as String
Make sure you enter the date in mm/dd/yyyy format when prompted. Also, please use code tags when posting any code.
 
Last edited:
Upvote 0
Re: Need help with VBA coding

Should be
Code:
Dim response as String
Make sure you enter the date in mm/dd/yyyy format when prompted. Also, please use code tags when posting any code.

Perhaps it is standard as it is different keyboard. I also tried mm/dd/yyyy but I think it doesn't recognise the format.

were you able to try out for the code?

once I have autofilter the data, how would it be possible to transfer to the overview tab based on the criteria? (Column I)
 
Upvote 0
Re: Need help with VBA coding

I am totally confused at this point. In the Material Development workbook, in sheet "Purchase Costs" you say: "Extract from the combined data wb". Which workbook is the combined data wb? Using the three workbooks, could you do the following:

-referring to the workbook name, sheet name and column header, post a list of columns you want copied and also referring to the workbook name, sheet name and column header, state where you want the data pasted. For example:

In workbook "Invoice_List_Purchase_2018, sheet "USD", copy column C - "Description" and paste in workbook "Material Development", sheet "Purchase Costs", column D.

Do this for all the columns you want copied and pasted. I think that this is the only way I will be clear on what you want to do.
 
Upvote 0
Re: Need help with VBA coding

I am totally confused at this point. In the Material Development workbook, in sheet "Purchase Costs" you say: "Extract from the combined data wb". Which workbook is the combined data wb? Using the three workbooks, could you do the following:

-referring to the workbook name, sheet name and column header, post a list of columns you want copied and also referring to the workbook name, sheet name and column header, state where you want the data pasted. For example:

In workbook "Invoice_List_Purchase_2018, sheet "USD", copy column C - "Description" and paste in workbook "Material Development", sheet "Purchase Costs", column D.

Do this for all the columns you want copied and pasted. I think that this is the only way I will be clear on what you want to do.

In workbook "Invoice_List_Purchase_2018, sheet "USD", copy column G - "Description" and paste in workbook "Material Development", sheet "Purchase Costs", column D.
workbook "Invoice_List_Purchase_2018, USD sheet copy column A and paste into WB Material development sheet column A
WB "Invoice_List_Purchase_2018, USD sheet copy column D and paste into WB Material development sheet Purchase Costs column B
WB "Invoice_List_Purchase_2018, USD sheet copy column E and paste into WB Material development sheet Purchase Costs column C
WB "Invoice_List_Purchase_2018, USD sheet copy column H and paste into WB Material development sheet Purchase Costs column E
WB "Invoice_List_Purchase_2018, USD sheet copy column L and paste into WB Material development sheet Purchase Costs column G
WB "Invoice_List_Purchase_2018, USD sheet copy column N and paste into WB Material development sheet Purchase Costs column H
WB "Invoice_List_Purchase_2018, USD sheet copy column H and paste into WB Material development sheet Purchase Costs column E
WB "Invoice_List_Purchase_2018, USD sheet copy column S and paste into WB Material development sheet Purchase Costs column I
WB "Invoice_List_Purchase_2018, EUR sheet copy column D and paste into WB Material development sheet Purchase Costs column B
WB "Invoice_List_Purchase_2018, EUR sheet copy column E and paste into WB Material development sheet Purchase Costs column C
WB "Invoice_List_Purchase_2018, EUR sheet copy column F and paste into WB Material development sheet Purchase Costs column D
WB "Invoice_List_Purchase_2018, EUR sheet copy column G and paste into WB Material development sheet Purchase Costs column F
WB "Invoice_List_Purchase_2018, EUR sheet copy column K and paste into WB Material development sheet Purchase Costs column G
WB "Invoice_List_Purchase_2018, EUR sheet copy column M and paste into WB Material development sheet Purchase Costs column H
WB "Invoice_List_Purchase_2018, EUR sheet copy column S and paste into WB Material development sheet Purchase Costs column I

WB "Sale report, copy column A and paste into WB Material development sheet revenue Costs column B
WB "Sale report, copy column B and paste into WB Material development sheet revenue Costs column C
WB "Sale report, copy column C and paste into WB Material development sheet revenue Costs column D
WB "Sale report, copy column N and paste into WB Material development sheet revenue Costs column E
WB "Sale report, copy column L and paste into WB Material development sheet revenue Costs column G
WB "Invoice_List_Purchase_2018, USD sheet copy column N, and paste into WB Material development sheet revenue Costs column H
WB "Sale report, copy column P and paste into WB Material development sheet revenue Costs column I

-----------------------------------------------------------------------------------------------------------------------

Once this step is done, I would like to prompt auto filter in material development file purchase cost sheet Column A material, and invoice date between 1-5-2018 -31-5-2018, delete all the other entries.
For the revenue costs sheet, filter the invoice date within 1-5-2018-31-5-2018.
Furthermore, to allocate them to the respective WIP overview tab based on column I.

I hope that's more clear now.

Let me know if you need further clarification.

Thank you in advance.
 
Upvote 0
Formula split and update master tables into sub tables(product) - Aggregate/replace

Hi all,

I have been trying to work out this formula to auto populate per customer's status with a few steps, by implementing multiple excel functions e.g: replace, cell, aggregate, index:

B1 Formula = REPLACE(CELL("filename";A1);1;SEARCH("]";CELL("filename";A1));"")
B2 Formula =
COUNTIFS(Revenues[Customer];B1)
A5 Formula =
IF(ROWS(A$5:A5)>$B$2;"";INDEX(Revenues[Reference];AGGREGATE(15;6;(ROW(Revenues[Order type])-ROW(Revenues[Order type]))/(Revenues[[Customer]:[Customer]]=$B$1);ROWS(A$5:A5))))
File is saved in following link:
https://1drv.ms/x/s!Aqt4VfikFsyKdiapMYRPHtlSo5I

With this formula I was able to update all the rows of entries of Alianz DEW, but it doesn't work when I drill through and update the other customers, please take a look and give me a helping hand.

would be much appreciated !!

Thanks.


 
Last edited:
Upvote 0
Re: Formula split and update master tables into sub tables(product) - Aggregate/replace

Try this macro:
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
    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
    Application.ScreenUpdating = True
End Sub
Rows 37 and 38 from the USD sheet will not be included because they don't contain the word "Material". You will still have to enter the start and end dates. Unfortunately, you can't filter just by the month.
 
Upvote 0

Forum statistics

Threads
1,223,911
Messages
6,175,325
Members
452,635
Latest member
laura12345

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