Posts by ashu1990

Option Explicit
Sub test()
Dim lst1 As String, lst2 As String, ran As Range, ran1 As Range
lst1 = Me.listbox1.Value
lst2 = Me.listbox2.Value
Set ran = Range("G:G").Find(what:=lst1, MatchCase:=False)
If Not ran Is Nothing Then
Set ran1 = Range("H:H").Find(what:=lst2, MatchCase:=False)
TT:
        If ran.Row <> ran1.Row Then
        Debug.Print ran.Row
        Set ran = Range("G" & ran.Row + 1 & ":G" & Range("A:A").Rows.Count).Find(what:=ran, MatchCase:=False)
        GoTo TT:
        
        Else
        
        MsgBox ran.Row & " " & ran1.Row
        ''do your copy work
        
        End If
End If


End Sub

Sub AddPivotFields()
     
     
    Dim pvt As PivotTable
    Dim dr As String
    Dim dr_Name As String
    Dim c As Range
    Dim vcount As Long
     
     
     
     
     
     
     
     
    Set pvt = ActiveSheet.PivotTables("PivotTable1")
     
     
     
     
    pvt.PivotFields("Date").Orientation = xlRowField
    pvt.PivotFields("Date").LayoutForm = xlTabular
     
     
    pvt.PivotFields("Activity").Orientation = xlRowField
    pvt.PivotFields("Activity").Caption = "Activity"
    pvt.PivotFields("Activity").LayoutForm = xlTabular
     
     
    pvt.PivotFields("Activity").Subtotals = _
    Array(False, False, False, False, False, False, False, False, False, False, False, False)
     
     
    pvt.PivotFields("Code").Orientation = xlRowField
    pvt.PivotFields("Code").Caption = "Code"
    pvt.PivotFields("Code").LayoutForm = xlTabular
     
     'Direct and Indirect time do not change and are included within every report.
     
    dr = "Direct"
    dr_Name = "Direct Time"
     
     
    pvt.AddDataField pvt.PivotFields("Direct"), dr_Name, xlSum
    pvt.PivotFields("Direct Time").NumberFormat = "[h]:mm"
     
     
    dr = "Indirect"
    dr_Name = "Indirect Time"
     
     
    pvt.AddDataField pvt.PivotFields("Indirect"), dr_Name, xlSum
    pvt.PivotFields("Indirect Time").NumberFormat = "[h]:mm"
     
     'I am having trouble automating this section  I usually need to remove the comments with the code that are being used..
     'like this example I am using A215 & B300 it would be nice if i could have an array with all the codes so it could check itself.. I tried but never worked..


     '''put your criteria in array


    Dim i As Long, piv_obj As Object, arr As Variant
    
    arr = Array("A295", "B300")
    arr1 = Array("Avg A295", "Avg B300")
    
    For i = 0 To UBound(arr)
     
     Set piv_obj = pvt.PivotFields(arr(i))
     
    If Not piv_obj Is Nothing Then
     
    dr = arr(i)
    dr_Name = arr1(i)
    
    pvt.AddDataField pvt.PivotFields("A215"), dr_Name, xlAverage
    pvt.PivotFields("Avg A215").NumberFormat = "[h]:mm"
     
    End If
    
    Next i
    
   End Sub

Option Explicit
Sub test()
Dim sh As Worksheet, ran As Range, su As Double, rw As Long
Sheets.Add before:=Sheets(Sheets.Count - Sheets.Count + 1): ActiveSheet.Name = "Summary"
For Each sh In ActiveWorkbook.Worksheets
If sh.Name <> "Summary" Then
    Set ran = sh.Range("A:A").Find(what:="Total", MatchCase:=False)
    
     If Not ran Is Nothing Then
     
        rw = sh.Range("A:A").Find(what:="Total", MatchCase:=False).Row
        
        su = WorksheetFunction.Sum(sh.Range("G" & rw & ":L" & rw))
        
        Worksheets("Summary").Range("A" & Range("A:A").Rows.Count).End(xlUp).Offset(1, 0).Value = sh.Name
        Worksheets("Summary").Range("B" & Range("A:A").Rows.Count).End(xlUp).Offset(1, 0).Value = su
        su = 0
    End If
End If
Next sh
Worksheets("Summary").Range("A1").Value = "Sheet Name"
Worksheets("Summary").Range("B1").Value = "Total"
End Sub