Hi,
I need an automation code to shift daily time series based on chosen start and end date like 'shift' function in R with closest possible adhering to weekdays, weekends and holiday.
Please PM me with your email to share a file and more details with you.
I sent 10% payment to [email protected].
Thank you.
I have this formula but it will find unique value from only that range. How can I find unique value from another column base on that SUMPRODUCT function?
=SUMPRODUCT(--(Table2[Customer Type]="KEY"),--(Table2[SO Status]="Pending"),--(Table2[Time]=230) give me 97 unique values
I want to find unique value on Table2[CustomerNumber] based on above criteria.
Thank you!
Hello,
I have written a VBA code to copy after filter value on another workbook then paste to current workbook. But there is a problem is every month summary, they have different total items so that will cause total rows will not equal. If I copy by choosing whole column selection will make my data is not correct.
Can anybody help me with how to select each row in column ( month) in source workbook and lookup value on another 2 columns value ( size and color) then lookup 2 columns value (size and color) in target workbook if those match value will copy the value to column (like column V)?
Sub CopyFromClosedWorkbookTable()
'On Error GoTo AngryPiyomaru ' Error Handler
Dim targetWb As Workbook
Dim sourceWb As Workbook
Dim rng As Range
Dim tblRng As String
Dim lastRow As Long
Dim itemNo As String
Dim targetRng As String
Dim fileName As String
Dim fd As Office.FileDialog
Dim dateString As String
Dim targetTable As ListObject
dateString = Format(Sheets("Support").Range("B3").value, "m-d-yyyy")
Call ChDrive("S")
Call ChDir("S:\Prod_Publish\Forecasting_Model\2017 Forecasting Model")
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "S:\Prod_Publish\Forecasting_Model\2017 Forecasting Model"
.AllowMultiSelect = False
.Title = "Please select the file."
.Filters.Clear
.Filters.Add "Excel 2007", "*.xlsx?"
.InitialFileName = "*" & dateString & "*"
If .Show = True Then
fileName = Dir(.SelectedItems(1))
End If End With Application.EnableEvents = False Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set targetWb = ThisWorkbook
itemNo = targetWb.Sheets("Support").Cells(2, 2).value
Set sourceWb = Workbooks.Open(fileName, True, True) 'Open source Workbook in read-only mode
sourceWb.Sheets("Main").Activate
sourceWb.Sheets("Main").Outline.ShowLevels ColumnLevels:=2
lastRow = sourceWb.Sheets("Main").Range("Q" & Rows.Count).End(xlUp).Row + 1
' Auto-filter
sourceWb.Sheets("Main").Range("C5:Y5").Select ' From Category to Current M + 6 Sales plan
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:="*" & itemNo & "*", Operator:=xlFilterValues
Range("O6:O" & lastRow).SpecialCells(12).Select ' Column V is 5 month Sales plan
Selection.Copy
'Paste
Set targetTable = targetWb.Sheets("Data").ListObjects("FCMTable")
tblRng = Format(ThisWorkbook.Sheets("Support").Range("B3").value, "m/d/yyyy")
targetWb.Worksheets("Data").Activate
targetTable.ListColumns(tblRng).DataBodyRange.PasteSpecial xlPasteValues
' Close source Workbook
sourceWb.Close
' Error Handler
AngryPiyomaru:
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = False
End SubYou are awesome.:ole:
Can someone help me to fix my code to link 2 module ActiveX combo box to act as a filter based on another combo box, please?
In my test file, I want cboColor will show value based on selection on cboStyle.
Sub Continue()
Dim objDict As Object, db, xCell
Dim rng As Range
Dim ws As Worksheet
With Sheets("ProductMaster").ListObjects("ProductMaster").Range
.AutoFilter Field:=5
.AutoFilter Field:=4
.AutoFilter Field:=3
End With
Set ws = Worksheets("ProductMaster")
Set rng = ws.Range("C2:c" & ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1)
Set objDict = CreateObject("Scripting.Dictionary")
objDict.CompareMode = vbTextCompare With Worksheets("ProductMaster")
For Each xCell In rng
If Not objDict.exists(xCell.Value) Then
objDict.Add xCell.Value, Nothing
End If
Next xCell
End With
Worksheets("Dashboard").cboStyle.List = objDict.Keys
objDict.RemoveAll
'Refresh Everything
ActiveWorkbook.RefreshAll End SubPrivate Sub cboStyle_Change()
Dim objDict As Object, db
Dim rngArea As Range, AreaItems, xCell
Set objDict = CreateObject("Scripting.Dictionary")
objDict.CompareMode = vbTextCompare
With Sheets("ProductMaster").ListObjects("ProductMaster").Range
.AutoFilter Field:=5
.AutoFilter Field:=4
.AutoFilter Field:=3, Criteria1:="=" & Worksheets("Dashboard").cboStyle.Value, Operator:=xlFilterValues
.AutoFilter Field:=2
.AutoFilter Field:=1
End With
On Error Resume Next ' Error Handler
Set rngArea = Worksheets("ProductMaster").Range("ProductMaster").Resize(, 5).SpecialCells(12)
On Error Resume Next ' Error Handler
For Each AreaItems In rngArea.Areas
db = AreaItems.Value
For xCell = LBound(db) To UBound(db)
If Not objDict.exists(db(xCell, 4)) Then
objDict.Add db(xCell, 4), Nothing
End If
Next
Next
On Error GoTo 0 ' Error Handler
End SubThat 's perfect. Thank you so much for your help Pike. I appreciative your help. 
Another issue is if I change date format on Column C (Month) to "mmm-yy" or any formats which are not Short Date (m/d/yyyy). It will have error with no cells select or available. 
Hello, something like ,,
CodeDisplay MorePrivate Sub cboCategory_Change() Dim objDict As Object, db Set objDict = CreateObject("Scripting.Dictionary") objDict.CompareMode = vbTextCompare With Sheets("Sheet2").ListObjects("Table2").Range .AutoFilter Field:=3 .AutoFilter Field:=2 .AutoFilter Field:=1, Criteria1:="=" & cboCategory.Value, Operator:=xlFilterValues End With Set rngArea = Sheets("Sheet2").Range("Table2").Resize(, 5).SpecialCells(12) For Each AreaItems In rngArea.Areas db = AreaItems.Value For xCell = LBound(db) To UBound(db) If Not objDict.exists(db(xCell, 2)) Then objDict.Add db(xCell, 2), Nothing End If Next Next Me.cboColor.List = objDict.Keys objDict.RemoveAll End Sub
That's awesome. Thank you so much Pike.
I have changed 2 text box to sheet 2 to test.
But another issue is 2 text box not show the correct number to edit. It only cache couple rows to show. If I edit that number, it will changed to another row, not correct row like show on combo box.
How can I fix it?
Good day
I am new to VBA.
I need help with a userform that I created to edit data from my table. When I click list drop down button on all 3 combo, they show me a very long list to choose from.
How can I narrow the list with only the same value like we click on filter drop down button on sheet filter?
And how can the second combo box only show values based on the first combo box?
I attached my file for review.
I hope someone may be able to assist me.
Thank you so much.