Posts by taylorpa5

Option Explicit
Dim ws As Worksheet
Dim lastrow As Long, x As Long




Sub Sub(A)




'Set's up the Archer Export for formatting, column insertion and MS Access append.
    
    ActiveWorkbook.Sheets(1).Activate
    
    Application.ScreenUpdating = False
    
    'Rename the sheet
    ActiveSheet.Name = "ArcherRawData"
    
        'Go to last oolumn with a name and insert Column Names




        With Sheets("ArcherRawData")
        Cells(1, Range("A1").End(xlToRight).Column + 1).Value = "VP"
        Cells(1, Range("A1").End(xlToRight).Column + 1).Value = "Overdue"
        Cells(1, Range("A1").End(xlToRight).Column + 1).Value = "Priority"
        Cells(1, Range("A1").End(xlToRight).Column + 1).Value = "VP Last Name"
        Cells(1, Range("A1").End(xlToRight).Column + 1).Value = "Severity Level"
        Cells(1, Range("A1").End(xlToRight).Column + 1).Value = "Export Date"




        'Create Named Range


        Range("A1").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
        False
        Range("A1").Select
        
        'Set VP Tower Assignment
        Call Sub (B) '<-------See Below for code !!!!
                      
        'Set Export Date


        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("AN2:AN" & lastrow).Formula = _
        "=today()"
        
        'Set Overdue Date


        .Range("AJ2:AJ" & lastrow).Formula = _
        "=IF(Due_Date<Export_Date,""Yes"",""No"")"
        
        'Set VP LastName


        .Range("AL2:AL" & lastrow).Formula = _
        "=IFERROR(RIGHT(VP,LEN(VP)-FIND("" "",VP,1)),""Import VP!!"")"
        
        'Set Severity Level


        .Range("AM2:AM" & lastrow).Formula = "=IF(Severity=3,""Sev 3"",IF(Severity=4,""Sev 4"",IF(Severity=5,""Sev 5"","""")))"
        
        'Set Priority Level


        .Range("AK2:AK" & lastrow).Formula = _
        "=IF(AND(OR(Scan_Type=""External""),AND(Exploitability<>""Unproven"",Exploitability<>"""")),1,IF(AND(OR(Scan_Type=""Internal"",Scan_Type=""DMZ""),AND(Exploitability<>""Unproven"",Exploitability<>"""")),2,IF(AND(OR(Scan_Type=""External""),AND(Exploitability=""Unproven"")),3,IF(AND(OR(Scan_Type=""External""),AND(Exploitability="""")),3,IF(AND(OR(Scan_Type=""Internal"",Scan_Type=""DMZ""),AND(Exploitability=""Unproven"")),4,IF(AND(OR(Scan_Type=""Internal"",Scan_Type=""DMZ""),AND(Exploitability="""")),4,""??""))))))"
        'Set Assignments (Big nasty formula}
        
        
        'Convert all formulas to text        
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A1").Select




        
        'Delete "Evidence" and "Findings & Observations" columns        
        Columns("AD").EntireColumn.Delete
        Columns("X").EntireColumn.Delete
        Columns("U").EntireColumn.Delete
        Columns("D").EntireColumn.Delete
        
        'Adjust Columns
        Cells.ColumnWidth = 30
        
        'File Save As
        Call MoveSaveAS
        
        End With
        
    Application.ScreenUpdating = True
    
End Sub




'**************************************************************************
Sub B()




'Assign VP names to VL tower column in Archer RawData tab.  This subroutine to be "called" in Primary Script (ARCHER_SubRoutines)




    ActiveWorkbook.Sheets(1).Activate
    
    Set ws = Sheet1 '<----change to suit
    lastrow = ws.Range("F" & Rows.Count).End(xlUp).Row
    
    For x = 2 To lastrow '<---data starts in row 2. if not change this
        
        Select Case ws.Range("F" & x).Value
        
        
        'John Doe 1
        Case "Run-Application Support", "Run-Citrix", "Run-Data Protection/Recovery Management", "Run-Database", _
        "Run-Exchange/Messaging", "Run-Exchange/Server", "Run-Middleware", "Run-Network/Telecom", "Run-Production Operations", "Run-RxConnect", _
        "Run-Server", "Run-Server/Middleware", "Run-Server-HPNS", "Run-Storage", "Run-Storage/Database", "Run-Team Leads-RxAmerica", _
        "Run-Windows/Messaging", "Run-Windows-Server", "Run-AS400 (iSeries)", "Run-Mainframe"
        
        ws.Range("AI" & x).Value = "Justin Skelton"




        'John Doe 2
        Case "Firewall Security", "Predecommission", "Uncorrelated"
        ws.Range("AI" & x).Value = "Justin Skelton (Uncorrelated)"




        
        'John Doe 3
        Case "Retail System-Logistics", "Retail System-Pharmacy Systems", "Retail Systems - Minute Clinic Systems", "Retail Systems Store Systems", _
        "Retail Systems-Corporate Systems", "Retail Systems-Enterprise Systems", "Retail Systems-Logistics", "Retail Systems-Merch/Mkting", _
        "Retail Systems-Omnicare LTC", "RRetail Systems-Omnicare RTL", "Retail Systems-Omnicare RxC", "Retail Systems-Pharmacy Systems", _
        "Retail Systems-Store Operations", "Retail Systems-Store Systems"
        
        ws.Range("AI" & x).Value = "Ray Auger"
        
        'John Doe 4
        Case "PBM IT-Quality Assurance"
        ws.Range("AI" & x).Value = "James Grubisic"




       End Select
    Next x
End Sub




Sub MoveSaveAS()
' Copies ArcherRawData sheet to new workbook to append in Access table
    
    Sheets("ArcherRawData").Select
    Sheets("ArcherRawData").Copy
    Application.WindowState = xlMaximized
    Application.GetSaveAsFilename
    
End Sub

Sub EndUserSupport()
     
    Set ws = Sheet1 '<----change to suit
     
    lastrow = ws.Range("R" & Rows.Count).End(xlUp).Row




    For x = 2 To lastrow '<---data starts in row 2. if not change this
  
  '***CODE DOESN'T EXCUTE FROM HERE.....
      
        Select Case ws.Range("R" & x).Value
             
        Case "Windows 7 Enterprise 64 bit Edition Service Pack 1"
            ws.Range("AV" & x).Value = "End User Support"
             
        Case "Windows XP"
            ws.Range("AV" & x).Value = "End User Support"
             
        Case "HP LaserJet"
            ws.Range("AV" & x).Value = "End User Support"
            
        End Select
    Next x


'***TO HERE^^^^^




End Sub

Sub EndUserSupport()




Select Case Range("R2").Value




          Case "Windows 7 Enterprise 64 bit Edition Service Pack 1"
              Range("AV2).Value = "End User Support"




          Case "Windows XP"
              Range("AV2").Value = "End User Support"




          Case "HP LaserJet"
              Range("AV2").Value = "End User Support"




    End Select
End Sub

Option Explicit
Dim lastRow As Long
'Set's up the Archer Export for formatting, column insertion and MS Access append.




Sub ArcherNamedRange()
        
    'Rename the sheet
    ActiveSheet.Name = "RawData"




    'Insert Column Names
    With Sheets("RawData")
        Cells(1, Range("A1").End(xlToRight).Column + 1).Value = "VP"
        Cells(1, Range("A1").End(xlToRight).Column + 1).Value = "Overdue"
        Cells(1, Range("A1").End(xlToRight).Column + 1).Value = "Priority"
        Cells(1, Range("A1").End(xlToRight).Column + 1).Value = "Export Date"
        
        'Create Named Range
        Range("A1").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.CreateNames Top:=True, Left:=False, Bottom:=False, Right:= _
        False
        Range("A1").Select
        
        'PROBLEM AREA
        .Range("AI2:AI" & lastRow).Formula = _
        "=IF(AND(OR(Scan_Type=""External""),AND(Exploitability<>""Unproven"",Exploitability<>"")),1," _
       & "IF(AND(OR(Scan_Type=""Internal"",Scan_Type=""DMZ""),AND(Exploitability<>""Unproven"",Exploitability<>"""")),2," _
       & "IF(AND(OR(Scan_Type=""External""),AND(Exploitability=""Unproven"")),3," _
       & "IF(AND(OR(Scan_Type=""Internal"",Scan_Type=""DMZ""),AND(Exploitability=""Unproven"")),4,""??""))))"
        
        
        'Set Export Date
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("AJ2:AJ" & lastRow).Formula = _
        "=today()"
        
        'Set Overdue Date
        .Range("AH2:AH" & lastRow).Formula = _
        "=IF(Due_Date<Export_Date,""Yes"",""No"")"
        
        'Set VP Name
        
        
        'Convert all formulas to text
        
        
        'Adjust Columns
        Cells.ColumnWidth = 30
    
    End With
End Sub

Option Explicit
Dim lastRow As Long
 
Sub ArcherFileSetUp()
'Set's up the Archer Export for formatting and MS Access append.
   
    'Rename the sheet
    ActiveSheet.Name = "RawData"
   
    'Insert Column Names
    With Sheets("RawData")
        Range("AG1") = "VP"
        Range("AH1") = "Overdue"
        Range("AI1") = "Priority"
        Range("AJ1") = "Export Date"
       
   
        'Create Named Range
        Range("A1").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Application.Goto Reference:="ARCHER"
       
'*********************************** 
        'Set Export Date
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("AJ2:AJ" & lastRow).Formula = _
        "=today()"
 
        'Set Overdue Date
        .Range("AH2:AH" & lastRow).Formula = _
        "=IF(M2<AJ2,""Yes"",""No"")"
[COLOR=#FF0000] [/COLOR]
'*********************************** 






        'Adjust Columns
        Cells.ColumnWidth = 30
       
    End With
End Sub

Sub ACCESS_OCIInventorySetup()
    
    'Copy over unclean part number into new column range


    For Each ws In ActiveWorkbook.Worksheets
    ws.Activate
    
    
        Range("J1").Value = "Clean Part No"
        For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
        
        Cells(i, "J") = Cells(i, "C").Value
        
        Next i
        
        'Substitute all special characters and spaces and replace with ""
        Intersect(Columns("J"), ActiveSheet.UsedRange).NumberFormat = "@"


        For Each v In Array(" ", ".", "#", "-", "/", "~*", "(", ")", "BAV", "OCI", "ATT", "\", "LVN", "SDC")


        Columns("J").Replace v, "", xlPart


        Next v
    
    Next ws
 
End Sub

Sub ACCESS_OCIInventorySetup()
    
    'Copy over unclean part number into new column range
    Sheetcount = ActiveWorkbook.Worksheets.Count


    For S = 1 To Sheetcount
   
        Range("J1").Value = "Clean Part No"
        For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
        
        Cells(i, "J") = Cells(i, "C").Value
        
        Next i
        
        'Substitute all special characters and spaces and replace with ""
        Intersect(Columns("J"), ActiveSheet.UsedRange).NumberFormat = "@"


        For Each v In Array(" ", ".", "#", "-", "/", "~*", "(", ")", "BAV", "OCI", "ATT", "\", "LVN", "SDC")


        Columns("J").Replace v, "", xlPart


        Next v
    
    Next S
 
End Sub

With MultiPage1.Page1
ControlIndex = 12
For x = 1 To 42   'X is the number of TextBox Controls
iRow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row


'Iterate through textboxes to check for null values.  If null, then skip...
    If Me.Controls("Textbox" & x).Value > "" Then
        ws.Cells(iRow, 1).Value = MultiPage1.Page1.Caption 'Project Information
        ws.Cells(iRow, 2).Value = Me.Controls("Label" & ControlIndex).Caption
        ws.Cells(iRow, 3).Value = Me.Controls("Label" & ControlIndex + 1).Caption
        ws.Cells(iRow, 4).Value = Me.Controls("Label" & ControlIndex + 2).Caption
        ws.Cells(iRow, 5).Value = Me.Controls("Label" & ControlIndex + 3).Caption
        ws.Cells(iRow, 6).Value = Me.Controls("Label" & ControlIndex + 4).Caption
        ws.Cells(iRow, 7).Value = Me.Controls("Label" & ControlIndex + 5).Caption
        ws.Cells(iRow, 8).Value = Me.Controls("Label" & ControlIndex + 6).Caption
        ws.Cells(iRow, 9).Value = Label703.Caption 'User ID
        ws.Cells(iRow, 10).Value = Label704.Caption ' Date Submitted
        ws.Cells(iRow, 11).Value = Me.Controls("TextBox" & x).Value
        [COLOR=#ff0000]ws.Cells(iRow, 12).Value = Me.Controls("TextBox" & x).Value[/COLOR]
        ControlIndex = ControlIndex + 7
    End If
    Next x
    End With