Posts by NickW

Sub tester_filter()
' Filter list of testers from Plan to dashboard and show how many line items each one is working on
     
     
' Set file path for temp worksheet (if it doesn't exits just create temp.xls and enter file path below)
    Dim Temp                   As String
    Dim NewBook                 As Workbook
    Dim wbSource               As Workbook
    Dim RowCount               As Long
     
    Set wbSource = ActiveWorkbook
     
'No longer needed
'Temp = wbSource.Sheets("Dashboard").Range("j2").value
     
' Check that filename has been set
'    If Temp = "" Then
'        MsgBox "Please set the temp file location before you continue", vbCritical, "File Location"
'        Exit Sub
         
'    End If
     
'    If Dir(Temp) <> "" Then
'        MsgBox "Temp file found. Click OK to continue", vbInformation, "Success"
'    Else
'        MsgBox "Temp file doesn't exist, please check the file path & name and try again", vbCritical, "File not found"
'        Exit Sub
'    End If
     
' Turn off screen flicker
    Application.ScreenUpdating = False
     
' open temp workbook
'    Set NewBook = Workbooks.Open(Filename:=Temp)
'   create a new workbook
    Set NewBook = Workbooks.Add
    With NewBook
     
    End With
' Select worksheet dashboard and delete current list
    With wbSource
        .Sheets("Dashboard").Rows("24:100").Delete Shift:=xlUp
'Copy range of testers to new sheet
        .Sheets("Plan").Range("D3:D200").Copy NewBook.ActiveSheet.Range("A1")
    End With
    With NewBook.ActiveSheet
        .Range("a1:a200").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range( _
        "b1"), Unique:=True
' Paste new filtered list to dashboard
        .Range("b2:b200").Copy Destination:=wbSource.Sheets("Dashboard").Range("B24")
    End With
' close temp book
    NewBook.Close SaveChanges:=False
     
' Sort list into alphabetical order
    With wbSource
        With .Worksheets("Dashboard").Sort
            With .SortFields
                .Clear
                .Add Key:=wbSource.Worksheets("Dashboard").Range("B24"), SortOn:=xlSortOnValues, _
                Order:=xlAscending, DataOption:=xlSortNormal
            End With
            .SetRange wbSource.Worksheets("Dashboard").Range("B24:B50")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
 ' Add Auto Filter to Plan Sheet
        .Sheets("Plan").Range("A2:T2").AutoFilter
 ' Select dashboard, update formula and draw borders
        With .Sheets("Dashboard")
            RowCount = Application.WorksheetFunction.CountA(.Range("b24:b100"))
            With .Range("c24:c" & RowCount + 23)
                .FormulaR1C1 = "=COUNTIF(Plan!R3C4:R200C4,RC[-1])"
                .Borders.LineStyle = xlContinuous
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
            End With
        End With
    End With
     
' Turn on screen updating
    Application.ScreenUpdating = True
     
End Sub

Sub tester_filter()
 'Filter list of testers from Plan to dashboard and show how many line items each one is working on




'Set file path for temp worksheet (if it doesn't exits just create temp.xls and enter file path below)
Dim ThisFileName, Temp As String




 ThisFileName = ActiveWorkbook.Name
 Sheets("Dashboard").Select
 Range("j2").Select
 Temp = ActiveCell
 
'Check that filename has been set
    If Temp = "" Then
    MsgBox "Please set the temp file location before you continue", vbCritical, "File Location"
    End
    Else
        
    End If
    
If Dir(Temp) <> "" Then
    MsgBox "Temp file found. Click OK to continue", vbInformation, "Success"
Else
    MsgBox "Temp file doesn't exist, please check the file path & name and try again", vbCritical, "File not found"
    End
End If




    
'Turn off screen flicker
    Application.ScreenUpdating = False
'Select worksheet dashboard and delete current list
    Sheets("Dashboard").Select
    Rows("24:100").Select
    Selection.Delete Shift:=xlUp
'Select Plan and range of testers
    Sheets("Plan").Select
    Range("D3:D200").Select
    Selection.Copy
 'Filter range to new sheet
    Workbooks.Open Filename:=Temp
    Range("a1").Select
    ActiveSheet.Paste
    Range("a1:a200").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "b1"), Unique:=True
'Select range on sheet
    Range("b2:b200").Select
    Selection.Copy
'Select UAT Prep dashboard worksheet and paste new filtered list
    'Windows("New UAT Prep Sheet - Sandbox.xlsm").Activate
    Windows(ThisFileName).Activate
        Sheets("Dashboard").Select
    Range("B24").Select
    ActiveSheet.Paste
'Sort list into alphabetical order
    ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Dashboard").Sort.SortFields.Add Key:=Range("B24") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Dashboard").Sort
        .SetRange Range("B24:B50")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
'Add Auto Filter to Plan Sheet
    Sheets("Plan").Select
    Range("A2:T2").Select
    Selection.AutoFilter
'Select dashboard, update formula and draw borders
    Sheets("Dashboard").Select
    ActiveWindow.ScrollColumn = 1
    RowCount = Application.WorksheetFunction.CountA(Range("b24:b100"))
    Range("c24").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(Plan!R3C4:R200C4,RC[-1])"
    Range("c24").Borders(xlEdgeLeft).LineStyle = xlContinuous
    Range("c24").Borders(xlEdgeTop).LineStyle = xlContinuous
    Range("c24").Borders(xlEdgeRight).LineStyle = xlContinuous
    Range("c24").Borders(xlEdgeBottom).LineStyle = xlContinuous
    Range("c24:c" & RowCount + 23).Select
       With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
       End With
    Selection.FillDown
    Range("a1").Select
'Close temp work sheet




    Workbooks(Temp).Close SaveChanges:=False
   'Turn on screen updating
    Application.ScreenUpdating = True
    
End Sub

Sub InsertRowsAndFillFormulas_caller()
  '-- this macro shows on Tools, Macro..., Macros (Alt+F8) dialog
  Call InsertRowsAndFillFormulas
End Sub
 
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)
ActiveSheet.Unprotect Password:="password"
' Documented:  [url]http://www.mvps.org/dmcritchie/excel/insrtrow.htm[/url]
' Re: Insert Rows --   1997/09/24 Mark Hill <[email protected]>
   ' row selection based on active cell -- rev. 2000-09-02 David McRitchie
   Dim x As Long
   ActiveCell.EntireRow.Select  'So you do not have to preselect entire row
   If vRows = 0 Then
    vRows = Application.InputBox(prompt:= _
      "How many rows do you want to add?", Title:="Add Rows", _
      Default:=1, Type:=1) 'Default for 1 row, type 1 is number
    If vRows = False Then Exit Sub
   End If


   'if you just want to add cells and not entire rows
   'then delete ".EntireRow" in the following line


   'rev. 2001-01-17 Gary L. Brown, programming, Grouped sheets
   Dim sht As Worksheet, shts() As String, i As Long
   ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
       Windows(1).SelectedSheets.Count)
   i = 0
   For Each sht In _
       Application.ActiveWorkbook.Windows(1).SelectedSheets
    Sheets(sht.Name).Select
    i = i + 1
    shts(i) = sht.Name


    x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup


    Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
     Resize(rowsize:=vRows).Insert Shift:=xlDown


    Selection.AutoFill Selection.Resize( _
     rowsize:=vRows + 1), xlFillDefault


    On Error Resume Next
    
    Selection.Offset(1).Resize(vRows).EntireRow. _
     SpecialCells(xlConstants).ClearContents
   Next sht
   Worksheets(shts).Select
ActiveSheet.Protect Password:="password", AllowDeletingRows:=True, DrawingObjects:=True, _
Contents:=True, Scenarios:=True
End Sub

Sub Merge()
Dim Cell_e, Cell_Sheet1 As Variant
Dim R, C As Integer
'This Macro is add the Test condtion and the precondtions together in 1 cell, before they are exported to TD


Sheet2.Select
R = 11
C = 9
Do Until Sheet1.Cells(R, 9).Value = ""
Cells(R, 9).Select
Cell_Sheet1 = Sheet1.Cells(R, 9).Value
Cell_e = Sheet2.Cells(R, 7).Value
Sheet2.Cells(R, 7) = "Test Condtion:  " & Cell_Sheet1 & Chr(10) & Chr(10) & "Test Preconditions    " & Cell_e
R = R + 1
Loop




End Sub