| Items | Date1 | Date2 | Date3 | Date4 | 
| Item 1 | Data | Data | Data | Data | 
| Item 2 | Data | Data | Data | Data | 
| Item 3 | Data | Data | Data | Data | 
| Item 4 | Data | Data | Data | Data | 
Suppose, if you have a combobox with the date range, and you want to show those date columns which fall in the given range, following is the code which you can use. The example takes a week input from the user, where, in the AN Column, the Combobox option is given and in the AO column, the actual date value is given. For example, in AN1 the value is given as February-17 to February-23, and in AO1, the value of Feb 17 is given as 39495.
Public Sub CMBMacro()
Dim prevIndx As Integer
Dim cmbValue As Long
Dim upRange As Long
Dim pivot As PivotTable
Dim pvtItm As PivotItem
Dim ifNum As Long
Dim iCounter As Integer
Dim strngArr() As String
Dim strngCn As String
Dim prvDate As Long
Dim position As Integer
Dim prevItm() As PivotItem
Dim indxChckd As Integer
Dim extDate As Integer
Dim bool As Boolean
indxChckd = Me.Range("k1").Value
cmbValue = Me.Range("AO" & indxChckd).Value - 1 ' It will take the Date selected in the combo.
upRange = cmbValue + 7 'It will add up 7 days to get the upper range of the week.
iCounter = 0
    If Not Application.EnableEvents Then
        Exit Sub
    End If
position = 2
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set pivot = Me.PivotTables(pvtName)
bool = False
    For Each pvtItm In pivot.PivotFields("Date").PivotItems
        If IsDate(pvtItm.Value) And pvtItm.RecordCount > 0 Then
            ifNum = CDate(pvtItm.Value)
            If ifNum > cmbValue And ifNum < upRange Then
                If pvtItm.Visible = False Then pvtItm.Visible = True
                    bool = True
                iCounter = iCounter + 1
            End If
        End If
    Next
    ReDim prevItm(iCounter)
    iCounter = 1
    
    For Each pvtItm In pivot.PivotFields("Date").PivotItems
        If IsDate(pvtItm.Value) And pvtItm.RecordCount > 0 Then
            ifNum = CDate(pvtItm.Value)
                If (ifNum <= cmbValue Or ifNum >= upRange) And pvtItm.Visible = True And bool Then
                    pvtItm.Visible = False
                End If
                
                If pvtItm.Visible = True Then
                    Set prevItm(iCounter) = pvtItm
                    iCounter = iCounter + 1
                End If
        End If
    Next
    
    
************************************************The Following Code sorts the date columns. It is required if the date columns are not sorted by default********* *************************************        
        For position = 1 To UBound(prevItm)
            prvDate = CDate(prevItm(position))
            For iCounter = position + 1 To UBound(prevItm)
                ifNum = CDate(prevItm(iCounter))
                    If prvDate > ifNum Then
                        prevItm(position).position = prevItm(iCounter).position
                    End If
            Next
        Next
        
        If Not bool Then
            MsgBox "No Items Found for this range.", vbCritical, "Error"
        End If
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Hope this has helped you all.
Thanks,
Vikas
 
 
3 comments:
Good post.
Opulently I agree but I dream the post should acquire more info then it has.
Amiable post and this mail helped me alot in my college assignement. Gratefulness you seeking your information.
Post a Comment