Please help!

E

elmysterio89

New Member
Joined
Aug 12, 2021
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
Hello,

1. How can i get script to remove parantheses for different sheets

2. get days in substat to stop deleting the 10s digit from general report

Thank you.


VBA Code: 
Dim i As Integer
Dim j As Integer
Dim length As Integer
Dim DTE As String
Dim DELTA As String
Dim Days(2) As String
Dim TM1(13) As String
Dim TM2(5) As String
Dim HK(10) As String
 
Dim KWInt() As Variant
Dim KW(20) As Variant
Dim OUT(20, 7) As Variant
 
' Initialization
 
Worksheets("Parameters").Activate       ' Ensures that the correct Worksheet is open, definitely necessary
 
' Read Parameters
 
If Worksheets("Parameters").UNK.Value = "True" Then TM1(1) = "UNK"          ' These If Loops check if the toggle buttons are pressed and if they are, put the worksheets into an array.
If Worksheets("Parameters").AGSM.Value = "True" Then TM1(2) = "AGSM"
If Worksheets("Parameters").AA.Value = "True" Then TM1(3) = "AA"
If Worksheets("Parameters").AGFF.Value = "True" Then TM1(4) = "AGFF"
If Worksheets("Parameters").SMS.Value = "True" Then TM1(5) = "SMS"
If Worksheets("Parameters").MSDF.Value = "True" Then TM1(6) = "MSDF"
If Worksheets("Parameters").SANA.Value = "True" Then TM1(7) = "SANA"
If Worksheets("Parameters").BKSP.Value = "True" Then TM1(8) = "BKSP"
If Worksheets("Parameters").MSI.Value = "True" Then TM1(9) = "MSI"
If Worksheets("Parameters").SDEV.Value = "True" Then TM1(10) = "SDEV"
If Worksheets("Parameters").SOF.Value = "True" Then TM1(11) = "SOF"
If Worksheets("Parameters").TAC.Value = "True" Then TM1(12) = "TAC"
If Worksheets("Parameters").OBTW_TM1.Value = "True" Then TM1(13) = "OBTW"
 
If Worksheets("Parameters").EOIR.Value = "True" Then TM2(1) = "EOIR "        ' These If Loops check if the toggle buttons are pressed and if they are, put the worksheets into an array.
If Worksheets("Parameters").AVMS.Value = "True" Then TM2(2) = "AVMS "
If Worksheets("Parameters").CNI.Value = "True" Then TM2(3) = "CNI "
If Worksheets("Parameters").EW.Value = "True" Then TM2(4) = "EW "
If Worksheets("Parameters").OBTW_TM2.Value = "True" Then TM2(5) = "OBTW"
 
If Worksheets("Parameters").H16_EF.Value = "True" Then Days(1) = "Sheet4"    ' These If Loops check if the toggle buttons are pressed and if they are, put the worksheets into an array.
If Worksheets("Parameters").H16_G.Value = "True" Then Days(2) = "Sheet5"     ' The reason that the sheet name is used for this one is because this sheet changes name each week due to the count at the end.
 
If Worksheets("Parameters").ALL.Value = "True" Then HK(1) = "Sheet4"
If Worksheets("Parameters").NEW.Value = "True" Then HK(2) = "Sheet7"
If Worksheets("Parameters").ANA.Value = "True" Then HK(3) = "Sheet8"
If Worksheets("Parameters").MON.Value = "True" Then HK(4) = "Sheet9"
If Worksheets("Parameters").APP_IMP.Value = "True" Then HK(5) = "Sheet10"
If Worksheets("Parameters").TST.Value = "True" Then HK(6) = "Sheet11"
If Worksheets("Parameters").CLS.Value = "True" Then HK(7) = "Sheet12"
If Worksheets("Parameters").DOC.Value = "True" Then HK(8) = "Sheet13"
If Worksheets("Parameters").MSOFD.Value = "True" Then HK(9) = "Sheet14"
If Worksheets("Parameters").STR.Value = "True" Then HK(10) = "Sheet15"
 
KWInt = ActiveSheet.ListObjects("Key_Words").DataBodyRange.Value    ' This records the values in the Table Object that the keywords are stored in. Variable name is Key Words Inter-step
 
i = 1
 
While KWInt(i, 1) <> Empty              ' This takes only the non-empty cells from the KWInt variable (<> is VBA Syntax for Does Not Equal).
    KW(i) = KWInt(i, 1)
  
    i = i + 1
Wend                                  
 
length = UBound(KW)
 
For i = 1 To length                     ' Combining the Arrays into a single array for convenience.
    OUT(i, 1) = KW(i)
Next
 
j = 1
 
For i = 1 To 13                         ' This For Loop takes only the sheets that were selected on the Parameters page. If this step is not done, then you will get an error code.
    If TM1(i) <> "" Then OUT(j, 2) = TM1(i): j = j + 1
Next
 
j = 1
 
For i = 1 To 5                          ' This For Loop takes only the sheets that were selected on the Parameters page. If this step is not done, then you will get an error code.
    If TM2(i) <> "" Then OUT(j, 3) = TM2(i): j = j + 1
Next
 
j = 1
 
For i = 1 To 2                          ' This For Loop takes only the sheets that were selected on the Parameters page. If this step is not done, then you will get an error code.
    If Days(i) <> "" Then OUT(j, 6) = Days(i): j = j + 1
Next
 
j = 1
 
For i = 1 To 10
    If HK(i) <> "" Then OUT(j, 7) = HK(i): j = j + 1
Next
 
OUT(1, 4) = Worksheets("Parameters").DTE.Value      ' This line grabs the value from the two drop down boxes and stores them in the OUT Array.
OUT(1, 5) = Worksheets("Parameters").DTE.Value
 
If RNo = 1 Then Call TM1R(FileName, OUT)            ' When this script is called, it is passed the RNo variable which tells it which of the 4 reports were selected for import. This tells it which of the 4 Subroutines to run.
If RNo = 2 Then Call TM2R(FileName, OUT)            ' This is a vital step, because each of the 4 reports is formatted minorly differently. In the future, this may be removed for efficiency.
If RNo = 3 Then Call CLOSED(FileName, OUT)
If RNo = 4 Then Call ALTMetrics(FileName, OUT)
If RNo = 5 Then Call H12K(FileName, OUT)
 
End Sub
 
Sub IdentifyFiles()
 
' Identify Files
 
' This script is designed to identify and import files into the database.
' Database.
 
' Declarations
 
Dim File As String
Dim Files As String
Dim break() As String
Dim RT1 As String
Dim RT2 As String
Dim RT3 As String
Dim RT4 As String
Dim CD As String
Dim CD1 As String
Dim ALT As String
Dim HED As String
 
Dim i As Byte
Dim j As Byte
 
' Initialization
 
On Error Resume Next                    ' ERROR HANDLING: This line allows the code to continue to run if an invalid file is selected until it reaches the error check.
 
' Select File
 
With Application.FileDialog(msoFileDialogFilePicker)        ' Opens a dialog box that lets the user select one Excel file for import.
    .AllowMultiSelect = True
    .Show
    .Filters.ADD "Excel Files", "*.xlsx; *.xlsm; *.xls; *.xlsb", 1
    If .SelectedItems(1) <> "" Then File = .SelectedItems(1)
    If .SelectedItems(2) = "" Then Files = 0
    If .SelectedItems(2) <> "" Then Files = .SelectedItems(2)
 
End With
 
' Reading Filename
 
RT1 = InStr(File, "TM1")                ' These determine which of the 4 file types was selected by the user. If an invalid file is chosen, the program would throw an error code in Read Parameters, not here. ** Marked for Future Improvement.**
RT3 = InStr(Files, "TM1")
RT2 = InStr(File, "TM2")
RT4 = InStr(Files, "TM2")
CD = InStr(File, "Days")
CD1 = InStr(Files, "Days")
ALT = InStr(File, "Alt")
HED = InStr(File, "H12K")
 
' This line detects if a valid file has been selected and if it has not it aborts execution.
If RT1 = 0 Then If RT2 = 0 Then If RT3 = 0 Then If RT4 = 0 Then If CD = 0 Then If CD = 0 Then If ALT = 0 Then If HED = 0 Then MsgBox ("Because you did not select a valid DCRB file, or the program was unable to recognize the file, the code is exiting."): Exit Sub
 
If RT1 > 0 Then i = 1                   ' Can now load two TM files, be they TM1 or TM2
If RT2 > 0 Then i = 2
If RT3 > 0 Then j = 1
If RT4 > 0 Then j = 2
If CD > 0 Then i = 3
If CD1 > 0 Then j = 3
If ALT > 0 Then i = 4
If HED > 0 Then i = 5
 
Call ReadParameters(File, i)            ' i is the RNo variable in Read Parameters.
Call ReadParameters(Files, j)
 
End Sub
 
Private Sub TM1R(FilePath As String, Para As Variant)
 
' TM1
 
' This code is used to extract data from TM1 format SAR files.
 
' Declarations
 
Dim FileName As String
Dim ScriptName As String
 
Dim OUT(1000, 16) As Variant
Dim break As Variant
Dim chop As Variant
 
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim y As Integer
 
Dim TST(1000, 10) As Integer
 
Dim KW(20) As String
Dim WB(20) As String
Dim WS As String
 
Dim DTE As String
 
Dim open_file As Workbook
 
' Read Parameters
 
For i = 1 To 20
    If Para(i, 1) <> 0 Then KW(i) = Para(i, 1)          ' The first column of the Para Array is the Keywords. Para is the OUT variable in Read Parameters.
    If Para(i, 2) <> 0 Then WB(i) = Para(i, 2)          ' The second column of the Para Array is the TM1 sheets to loop through.
Next
 
DTE = Para(1, 4)                        ' This is the date in the first drop down box in the Parameters sheet.
 
i = 0
j = 1
 
While i = 0                             ' This is a measurement of how long the WB vector is.
    If WB(j) = "" Then i = 1
  
    If WB(j) <> "" Then j = j + 1
Wend
 
WB(0) = j - 1                           ' This records the number of Worksheets to loop through, which due to how the While Loop is written is needs to have 1 subtracted from it.
 
i = 0
j = 1
 
While i = 0                             ' This is a measurement of how long the KW vector is.
    If KW(j) = "" Then i = 1
  
    If KW(j) <> "" Then j = j + 1
Wend
 
KW(0) = j - 1                           ' This records the number of Worksheets to loop through, which due to how the While Loop is written is needs to have 1 subtracted from it.
 
' Initialization
 
Set open_file = Workbooks.Open(FilePath)                            ' Open the file selected by the user.
FileName = Split(FilePath, "\")(UBound(Split(FilePath, "\")))       ' Takes the File Name and chops off the Directory.
 
break = Split(FileName, "_")(UBound(Split(FileName, "_")))          ' This and the next line extracts the Date from the File Name.
chop = Split(break, ".")(LBound(Split(break, ".")))
DTE = chop
 
n = 1
 
' Data Crawler
 
Workbooks(FileName).Activate            ' This activates the WorkBook selected by the user.
 
For i = 1 To WB(0)                      ' Loop through each of the Work Sheets selected.
    For j = 1 To 1000                   ' Read the first 1000 rows of data. This is sufficient for TM1 and TM2, but not for ALT Metrics or Closed.
        TST(j, i) = 0                   ' This is here to prevent accidental false positives.
      
        For k = 1 To 22                 ' Loop through the 22 columns of data in the sheet.
            For m = 1 To KW(0)          ' Loop through each of the keywords read in earlier.
                TST(j, i) = TST(j, i) + InStr(ActiveWorkbook.Worksheets(WB(i)).Cells(j, k), KW(m))  ' If the keyword is present in the cell, then this will be a positive, non-zero number.
            Next
        Next
      
        If TST(j, i) > 0 Then OUT(n, 1) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 2)
        If TST(j, i) > 0 Then OUT(n, 2) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 4)              ' If TST is greater than 0 record the SAR number, Title, Rank, Pri, Substatus, and Team.
        If TST(j, i) > 0 Then OUT(n, 3) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 8)
        If TST(j, i) > 0 Then OUT(n, 4) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 10)
        If TST(j, i) > 0 Then OUT(n, 5) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 11)
        If TST(j, i) > 0 Then OUT(n, 6) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 13)
        If TST(j, i) > 0 Then OUT(n, 7) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 18)
        If TST(j, i) > 0 Then OUT(n, 8) = DTE                                                       ' If TST is greater than 0 record date of report it was found on.
        If TST(j, i) > 0 Then OUT(n, 9) = "TM1"                                                     ' If TST is greater than 0 record type of report it was found in.
        If TST(j, i) > 0 Then OUT(n, 10) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 22)
        If TST(j, i) > 0 Then n = n + 1
    Next
Next
 
Workbooks(FileName).Close Savechanges:=False        ' Close TM1 without saving any changes.
 
' Output
 
ScriptName = ActiveWorkbook.Name
Workbooks(ScriptName).Activate              ' Open the V6.5 Excel Workbook
 
a = n - 1                               ' Determine the length of the OUT variable
b = ActiveWorkbook.Worksheets("Data_Sheet").Cells(1, 1)     ' Determine the starting point to write data
c = a + b - 1                           ' Determine the end cell for writing data
y = 1                                   ' Index
 
For i = b To c                          ' This writes the OUT variable to the proper rows in the SAR Data V6.5 Workbook.
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 2) = OUT(y, 1)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 3) = OUT(y, 2)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 4) = OUT(y, 3)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 5) = OUT(y, 4)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 6) = OUT(y, 5)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 7) = OUT(y, 6)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 8) = OUT(y, 7)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 9) = OUT(y, 8)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 10) = OUT(y, 9)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 11) = OUT(y, 10)
  
    y = y + 1
Next
 
ActiveWorkbook.Worksheets("Data_Sheet").Cells(1, 1) = c + 1     ' This updates the count in the Data Sheet. It is one above the actual number because this is the starting row index.
 
Call ComboBox                                                   ' This calls a function that updates the drop down boxes with the new dates available.
 
Worksheets("Menu").Activate             ' Return the user to the UI
End Sub
 
Private Sub TM2R(FilePath As String, Para As Variant)
 
' TM2
 
' This code is used to extract data from TM2 format SAR files.
 
' Declarations
 
Dim FileName As String
Dim ScriptName As String
 
Dim OUT(1000, 16) As Variant
Dim break As Variant
Dim chop As Variant
 
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim y As Integer
 
Dim TST(1000, 10) As Integer
 
Dim KW(20) As String
Dim WB(20) As String
Dim WS As String
 
Dim DTE As String
 
Dim open_file As Workbook
 
' Read Parameters
 
For i = 1 To 20
    If Para(i, 1) <> 0 Then KW(i) = Para(i, 1)                      ' The first column of the Para Array is the Keywords. Para is the OUT variable in Read Parameters.
    If Para(i, 3) <> 0 Then WB(i) = Para(i, 3)                      ' The third column of the Para Array is the TM2 sheets to loop through.
Next
 
DTE = Para(1, 4)                        ' This is the date in the first drop down box in the Parameters sheet.
 
i = 0
j = 1
 
While i = 0                             ' This is a measurement of how long the WB vector is.
    If WB(j) = "" Then i = 1
  
    If WB(j) <> "" Then j = j + 1
Wend
 
WB(0) = j - 1                           ' This records the number of Worksheets to loop through, which due to how the While Loop is written is needs to have 1 subtracted from it.
 
i = 0
j = 1
 
While i = 0                             ' This is a measurement of how long the KW vector is.
    If KW(j) = "" Then i = 1
  
    If KW(j) <> "" Then j = j + 1
Wend
 
KW(0) = j - 1                           ' This records the number of Worksheets to loop through, which due to how the While Loop is written is needs to have 1 subtracted from it.
 
' Initialization
 
Set open_file = Workbooks.Open(FilePath)                            ' Open the file selected by the user.
FileName = Split(FilePath, "\")(UBound(Split(FilePath, "\")))       ' Takes the File Name and chops off the Directory.
 
break = Split(FileName, "_")(UBound(Split(FileName, "_")))          ' This and the next line extracts the Date from the File Name.
chop = Split(break, ".")(LBound(Split(break, ".")))
DTE = chop
 
n = 1
 
' Data Crawler
 
Workbooks(FileName).Activate            ' This activates the WorkBook selected by the user.
 
For i = 1 To WB(0)                      ' Loop through each of the Work Sheets selected.
    For j = 1 To 1000                   ' Read the first 1000 rows of data. This is sufficient for TM1 and TM2, but not for ALT Metrics or Closed.
        TST(j, i) = 0                   ' This is here to prevent accidental false positives.
       
        For k = 1 To 22                 ' Loop through the 22 columns of data in the sheet.
            For m = 1 To KW(0)          ' Loop through each of the keywords read in earlier.
                TST(j, i) = TST(j, i) + InStr(ActiveWorkbook.Worksheets(WB(i)).Cells(j, k), KW(m))  ' If the keyword is present in the cell, then this will be a positive, non-zero number.
            Next
        Next
      
        If TST(j, i) > 0 Then OUT(n, 1) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 2)
        If TST(j, i) > 0 Then OUT(n, 2) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 4)              ' If TST is greater than 0 record the SAR number, Title, Rank, Pri, Substatus, and Team.
        If TST(j, i) > 0 Then OUT(n, 3) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 8)
        If TST(j, i) > 0 Then OUT(n, 4) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 10)
        If TST(j, i) > 0 Then OUT(n, 5) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 11)
        If TST(j, i) > 0 Then OUT(n, 6) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 13)
        If TST(j, i) > 0 Then OUT(n, 7) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 18)
        If TST(j, i) > 0 Then OUT(n, 8) = DTE                                                       ' If TST is greater than 0 record date of report it was found on.
        If TST(j, i) > 0 Then OUT(n, 9) = "TM2"                                                     ' If TST is greater than 0 record type of report it was found in.
        If TST(j, i) > 0 Then OUT(n, 10) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 22)
        If TST(j, i) > 0 Then n = n + 1
    Next
Next
 
Workbooks(FileName).Close Savechanges:=False        ' Close TM2 without saving any changes.
 
' Output
ScriptName = ActiveWorkbook.Name
Workbooks(ScriptName).Activate              ' Open the V6.5 Excel Workbook
 
a = n - 1                               ' Determine the length of the OUT variable
b = ActiveWorkbook.Worksheets("Data_Sheet").Cells(1, 1)     ' Determine the starting point to write data
c = a + b - 1                           ' Determine the end cell for writing data
y = 1                                   ' Index
 
For i = b To c                          ' This writes the OUT variable to the proper rows in the SAR Data V6.5 Workbook.
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 2) = OUT(y, 1)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 3) = OUT(y, 2)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 4) = OUT(y, 3)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 5) = OUT(y, 4)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 6) = OUT(y, 5)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 7) = OUT(y, 6)
   ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 8) = OUT(y, 7)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 9) = OUT(y, 8)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 10) = OUT(y, 9)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 11) = OUT(y, 10)
  
    y = y + 1
Next
 
ActiveWorkbook.Worksheets("Data_Sheet").Cells(1, 1) = c + 1     ' This updates the count in the Data Sheet. It is one above the actual number because this is the starting row index.
 
Call ComboBox                                                   ' This calls a function that updates the drop down boxes with the new dates available.
 
Worksheets("Menu").Activate             ' Return the user to the UI
End Sub
 
Private Sub CLOSED(FilePath As String, Para As Variant)
 
' CLOSED
 
' This code is used to extract data from CLOSED format SAR files.
 
' Declarations
 
Dim FileName As String
Dim ScriptName As String
 
Dim OUT(10000, 16) As Variant
Dim break As Variant
Dim chop As Variant
 
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim y As Integer
 
Dim TST(10000, 10) As Integer
 
Dim KW(20) As String
Dim CN(20) As String
Dim WB(20) As String
Dim WS As String
 
Dim DTE As String
 
Dim open_file As Workbook
 
' Read Parameters
 
j = 1
 
For i = 1 To 20                         ' This reads in the codewords from the parameters sheet.
    If Para(i, 1) <> 0 Then KW(i) = Para(i, 1)
    If Para(i, 6) <> 0 Then CN(i) = Para(i, 6): j = j + 1   ' The sixth column of the Para Array is the Days sheets to loop through.
Next
 
DTE = Para(1, 4)                        ' This is the date selected in the Parameters drop down box
 
WB(0) = j - 1                           ' Number of Worksheets to loop through
 
i = 0
j = 1
 
While i = 0                             ' This is a measurement of how long the KW vector is.
    If KW(j) = "" Then i = 1
  
    If KW(j) <> "" Then j = j + 1
Wend
 
KW(0) = j - 1                           ' This records the number of Worksheets to loop through, which due to how the While Loop is written is needs to have 1 subtracted from it.
 
' Initialization
 
Set open_file = Workbooks.Open(FilePath)                            ' Open the file selected by the user.
FileName = Split(FilePath, "\")(UBound(Split(FilePath, "\")))       ' Takes the File Name and chops off the Directory.
 
break = Split(FileName, "_")(UBound(Split(FileName, "_")))          ' This and the next line extracts the Date from the File Name.
chop = Split(break, ".")(LBound(Split(break, ".")))
DTE = chop
 
n = 1
 
' Generating Data
 
Workbooks(FileName).Activate            ' This activates the WorkBook selected by the user.
For i = 1 To WB(0)
    If CN(i) = "Sheet4" Then WB(i) = SHEETS(3).Name
    If CN(i) = "Sheet5" Then WB(i) = SHEETS(4).Name
Next
 
 
For i = 1 To WB(0)                      ' Loop through each of the Work Sheets selected.
    For j = 1 To 10000                  ' Read the first 10000 rows of data. This increased limit is needed for ALT Metrics or Closed.
        TST(j, i) = 0                   ' This is here to prevent accidental false positives.
      
        For k = 1 To 30                 ' Loop through the 22 columns of data in the sheet.
            For m = 1 To KW(0)          ' Loop through each of the keywords read in earlier.
                TST(j, i) = TST(j, i) + InStr(ActiveWorkbook.Worksheets(WB(i)).Cells(j, k), KW(m))  ' If the keyword is present in the cell, then this will be a positive, non-zero number.
            Next
        Next
      
        If TST(j, i) > 0 Then OUT(n, 1) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 2)
        If TST(j, i) > 0 Then OUT(n, 2) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 4)              ' If TST is greater than 0 record the SAR number, Title, Rank, Pri, Substatus, and Team.
        If TST(j, i) > 0 Then OUT(n, 3) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 8)
        If TST(j, i) > 0 Then OUT(n, 4) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 10)
        If TST(j, i) > 0 Then OUT(n, 5) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 11)
        If TST(j, i) > 0 Then OUT(n, 6) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 13)
        If TST(j, i) > 0 Then OUT(n, 7) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 18)
        If TST(j, i) > 0 Then OUT(n, 8) = DTE                                                       ' If TST is greater than 0 record date of report it was found on.
       If TST(j, i) > 0 Then OUT(n, 9) = "Days in Substatus"                                                     ' If TST is greater than 0 record type of report it was found in.
        If TST(j, i) > 0 Then OUT(n, 10) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 22)
        If TST(j, i) > 0 Then OUT(n, 11) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 30)
        If TST(j, i) > 0 Then n = n + 1
    Next
Next
 
Workbooks(FileName).Close Savechanges:=False        ' Close CLOSED without saving any changes.
 
' Output
 
ScriptName = ActiveWorkbook.Name
Workbooks(ScriptName).Activate              ' Open the V6.5 Excel Workbook
 
a = n - 1                               ' Determine the length of the OUT variable
b = ActiveWorkbook.Worksheets("Data_Sheet").Cells(1, 1)     ' Determine the starting point to write data
c = a + b - 1                           ' Determine the end cell for writing data
y = 1                                   ' Index
 
For i = b To c                          ' This writes the OUT variable to the proper rows in the SAR Data V6.5 Workbook.
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 2) = OUT(y, 1)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 3) = OUT(y, 2)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 4) = OUT(y, 3)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 5) = OUT(y, 4)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 6) = OUT(y, 5)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 7) = OUT(y, 6)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 8) = OUT(y, 7)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 9) = OUT(y, 8)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 10) = OUT(y, 9)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 11) = OUT(y, 10)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 12) = OUT(y, 11)
  
    y = y + 1
Next
 
ActiveWorkbook.Worksheets("Data_Sheet").Cells(1, 1) = c + 1     ' This updates the count in the Data Sheet. It is one above the actual number because this is the starting row index.
 
Call ComboBox                                                   ' This calls a function that updates the drop down boxes with the new dates available.
 
Worksheets("Menu").Activate             ' Return the user to the UI
End Sub
 
 
Private Sub ALTMetrics(FilePath As String, Para As Variant)
 
' ALTMetrics
 
' This code is used to extract data from ALTMetrics format SAR files.
 
' Declarations
 
Dim FileName As String
Dim ScriptName As String
 
Dim OUT(10000, 16) As Variant
Dim break As Variant
Dim chop As Variant
 
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim y As Integer
 
Dim TST(10000, 10) As Integer
 
Dim KW(20) As String
Dim WB(20) As String
Dim WS As String
 
Dim DTE As String
 
Dim open_file As Workbook
 
' Read Parameters
 
For i = 1 To 20                         ' This reads in the codewords from the parameters sheet.
    If Para(i, 1) <> 0 Then KW(i) = Para(i, 1)
Next
 
WB(1) = "SAR_DATA"                      ' This is the only sheet in the ALT Metrics report to loop through.
 
DTE = Para(1, 4)                        ' This is the date selected in the Parameters drop down box
 
i = 0                                   ' These are indexes that are used in the following loop.
j = 1
 
While i = 0                             ' This is a measurement of how long the WB vector is.
    If WB(j) = "" Then i = 1
  
    If WB(j) <> "" Then j = j + 1
Wend
 
WB(0) = j - 1
 
i = 0                                   ' These are indexes that are used in the following loop.
j = 1
 
While i = 0                             ' This is a measurement of how long the KW vector is.
    If KW(j) = "" Then i = 1
  
    If KW(j) <> "" Then j = j + 1
Wend
 
KW(0) = j - 1                           ' This records the number of Worksheets to loop through, which due to how the While Loop is written is needs to have 1 subtracted from it.
 
' Initialization
 
Set open_file = Workbooks.Open(FilePath)                            ' Open the file selected by the user.
FileName = Split(FilePath, "\")(UBound(Split(FilePath, "\")))       ' Takes the File Name and chops off the Directory.
 
break = Split(FileName, "_")(LBound(Split(FileName, "_")))          ' This and the next line extracts the Date from the File Name.
DTE = break
n = 1
 
' Generating Data
 
Workbooks(FileName).Activate            ' This activates the WorkBook selected by the user.
 
 
For i = 1 To WB(0)                      ' Loop through each of the Work Sheets selected.
    For j = 1 To 10000                  ' Read the first 10000 rows of data. This increased limit is needed for ALT Metrics or Closed.
        TST(j, i) = 0                   ' This is here to prevent accidental false positives.
      
        For k = 1 To 22                 ' Loop through the 22 columns of data in the sheet.
            For m = 1 To KW(0)          ' Loop through each of the keywords read in earlier.
                TST(j, i) = TST(j, i) + InStr(ActiveWorkbook.Worksheets(WB(i)).Cells(j, k), KW(m))  ' If the keyword is present in the cell, then this will be a positive, non-zero number.
            Next
        Next
      
        If TST(j, i) > 0 Then OUT(n, 1) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 4)              ' If TST is greater than 0 record the SAR number, Title, Rank, Pri, Substatus, and Team.
        If TST(j, i) > 0 Then OUT(n, 2) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 8)
        If TST(j, i) > 0 Then OUT(n, 3) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 10)
        If TST(j, i) > 0 Then OUT(n, 4) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 11)
        If TST(j, i) > 0 Then OUT(n, 5) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 13)
       If TST(j, i) > 0 Then OUT(n, 6) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 18)
        If TST(j, i) > 0 Then OUT(n, 7) = DTE                                                       ' If TST is greater than 0 record date of report it was found on.
       If TST(j, i) > 0 Then OUT(n, 8) = "ALTM"                                                    ' If TST is greater than 0 record type of report it was found in.
        If TST(j, i) > 0 Then OUT(n, 9) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 22)
        If TST(j, i) > 0 Then n = n + 1
    Next
Next
 
Workbooks(FileName).Close Savechanges:=False        ' Close ALT Metrics without saving any changes.
 
' Output
 
ScriptName = ActiveWorkbook.Name
Workbooks(ScriptName).Activate              ' Open the V6.5 Excel Workbook
 
a = n - 1                               ' Determine the length of the OUT variable
b = ActiveWorkbook.Worksheets("Data_Sheet").Cells(1, 1)     ' Determine the starting point to write data
c = a + b - 1                           ' Determine the end cell for writing data
y = 1                                   ' Index
 
For i = b To c                          ' This writes the OUT variable to the proper rows in the SAR Data V6.5 Workbook.
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 2) = OUT(y, 1)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 3) = OUT(y, 2)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 4) = OUT(y, 3)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 5) = OUT(y, 4)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 6) = OUT(y, 5)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 7) = OUT(y, 6)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 8) = OUT(y, 7)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 9) = OUT(y, 8)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 10) = OUT(y, 9)
  
    y = y + 1
Next
 
ActiveWorkbook.Worksheets("Data_Sheet").Cells(1, 1) = c + 1     ' This updates the count in the Data Sheet. It is one above the actual number because this is the starting row index.
 
Call ComboBox                                                   ' This calls a function that updates the drop down boxes with the new dates available.
 
Worksheets("Menu").Activate             ' Return the user to the UI
End Sub
 
Private Sub H12K(FilePath As String, Para As Variant)
 
Dim FileName As String
Dim ScriptName As String
 
Dim OUT(1000, 16) As Variant
Dim break As Variant
Dim chop As Variant
 
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim n As Integer
Dim y As Integer
 
Dim TST(1000, 10) As Integer
 
Dim KW(20) As String
Dim CN(20) As String
Dim WB(20) As String
Dim WS As String
 
Dim DTE As String
 
Dim open_file As Workbook
 
' Read Parameters
For i = 1 To 20
    If Para(i, 1) <> 0 Then KW(i) = Para(i, 1):                   ' The first column of the Para Array is the Keywords. Para is the OUT variable in Read Parameters.
    If Para(i, 7) <> 0 Then CN(i) = Para(i, 7): j = j + 1              ' The seventh column of the Para Array is the H12K sheets to loop through.
Next
 
DTE = Para(1, 4)                        ' This is the date in the first drop down box in the Parameters sheet.
 
WB(0) = j                           ' This records the number of Worksheets to loop through
 
i = 0
j = 1
 
While i = 0                             ' This is a measurement of how long the KW vector is. This is needed, because due to Data Type the UBound command does not give an accurate answer.
    If KW(j) = "" Then i = 1
  
    If KW(j) <> "" Then j = j + 1
Wend
 
KW(0) = j - 1                        ' This records the number of Worksheets to loop through, which due to how the While Loop is written is needs to have 1 subtracted from it.
 
i = 0
j = 1
 
' Initialization
 
Set open_file = Workbooks.Open(FilePath)                            ' Open the file selected by the user.
FileName = Split(FilePath, "\")(UBound(Split(FilePath, "\")))       ' Takes the File Name and chops off the Directory.
 
break = Split(FileName, "_")(UBound(Split(FileName, "_")))          ' This and the next line extracts the Date from the File Name.
chop = Split(break, ".")(LBound(Split(break, ".")))
DTE = chop
 
n = 1
 
For i = 1 To WB(0)
    If CN(i) = "Sheet4" Then WB(i) = SHEETS(4).Name 'ALL
    If CN(i) = "Sheet7" Then WB(i) = SHEETS(7).Name 'NEW
    If CN(i) = "Sheet8" Then WB(i) = SHEETS(10).Name 'ANA
    If CN(i) = "Sheet9" Then WB(i) = SHEETS(11).Name 'MON
    If CN(i) = "Sheet10" Then WB(i) = SHEETS(12).Name 'APP/IMP
    If CN(i) = "Sheet11" Then WB(i) = SHEETS(13).Name 'TST
    If CN(i) = "Sheet12" Then WB(i) = SHEETS(14).Name 'CLOSED
    If CN(i) = "Sheet13" Then WB(i) = SHEETS(15).Name 'DOC
    If CN(i) = "Sheet14" Then WB(i) = SHEETS(16).Name 'MSOFD
    If CN(i) = "Sheet15" Then WB(i) = SHEETS(17).Name 'STR
Next
 
i = 0
 
' Generating Data
 
Workbooks(FileName).Activate            ' This activates the WorkBook selected by the user.
 
 
For i = 1 To WB(0)                      ' Loop through each of the Work Sheets selected.
    For j = 1 To 1000                  ' Read the first 1000 rows of data.
        TST(j, i) = 0                   ' This is here to prevent accidental false positives.
      
        For k = 1 To 22                 ' Loop through the 22 columns of data in the sheet.
            For m = 1 To KW(0)          ' Loop through each of the keywords read in earlier.
                TST(j, i) = TST(j, i) + InStr(ActiveWorkbook.Worksheets(WB(i)).Cells(j, k), KW(m))  ' If the keyword is present in the cell, then this will be a positive, non-zero number.
            Next
        Next
      
        If TST(j, i) > 0 Then OUT(n, 1) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 2)
        If TST(j, i) > 0 Then OUT(n, 2) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 4)              ' If TST is greater than 0 record the SAR number, Title, Rank, Pri, Substatus, and Team.
        If TST(j, i) > 0 Then OUT(n, 3) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 8)
        If TST(j, i) > 0 Then OUT(n, 4) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 10)
        If TST(j, i) > 0 Then OUT(n, 5) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 11)
        If TST(j, i) > 0 Then OUT(n, 6) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 13)
        If TST(j, i) > 0 Then OUT(n, 7) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 18)
        If TST(j, i) > 0 Then OUT(n, 8) = DTE                                                       ' If TST is greater than 0 record date of report it was found on.
        If TST(j, i) > 0 Then OUT(n, 9) = "H12K_EF"                                                     ' If TST is greater than 0 record type of report it was found in.
        If TST(j, i) > 0 Then OUT(n, 10) = ActiveWorkbook.Worksheets(WB(i)).Cells(j, 22)
        If TST(j, i) > 0 Then n = n + 1
    Next
Next
 
Workbooks(FileName).Close Savechanges:=False        ' Close CLOSED without saving any changes.
 
' Output
 
ScriptName = ActiveWorkbook.Name
Workbooks(ScriptName).Activate              ' Open the V6.4 Excel Workbook
 
a = n - 1                               ' Determine the length of the OUT variable
b = ActiveWorkbook.Worksheets("Data_Sheet").Cells(1, 1)     ' Determine the starting point to write data
c = a + b - 1                           ' Determine the end cell for writing data
y = 1                                   ' Index
 
For i = b To c                          ' This writes the OUT variable to the proper rows in the SAR Data V6.5 Workbook.
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 2) = OUT(y, 1)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 3) = OUT(y, 2)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 4) = OUT(y, 3)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 5) = OUT(y, 4)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 6) = OUT(y, 5)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 7) = OUT(y, 6)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 8) = OUT(y, 7)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 9) = OUT(y, 8)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 10) = OUT(y, 9)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 11) = OUT(y, 10)
    ActiveWorkbook.Worksheets("Data_Sheet").Cells(i, 12) = OUT(y, 11)
  
    y = y + 1
Next
 
ActiveWorkbook.Worksheets("Data_Sheet").Cells(1, 1) = c + 1     ' This updates the count in the Data Sheet. It is one above the actual number because this is the starting row index.
 
Call ComboBox                                                   ' This calls a function that updates the drop down boxes with the new dates available.
 
Worksheets("Menu").Activate             ' Return the user to the UI
End Sub
 
Private Sub ComboBox()
 
' Combo Box
 
' The purpose of this script is to populate the drop down boxes each time the data import is run.
 
' Declarations
 
Dim a As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim ScriptName As String
 
Dim TST As Integer
 
Dim Data(10) As Variant
 
' Initialization
 
ScriptName = ActiveWorkbook.Name
Workbooks(ScriptName).Activate              ' Open the V6.4 Excel Workbook
Worksheets("Data_Sheet").Activate       ' Ensures that the correct Worksheet is open, definitely necessary
 
' Reading Dates in Data
 
a = Cells(1, 1) - 1                     ' This gets the number of SARs currently in the database.
k = 1                                   ' This is an index to be used in the for loop.
 
For i = 1 To a                          ' This reads all the SARs in the database to find the dates of data.
    TST = 0
  
    For j = 1 To UBound(Data)           ' This compares the dates found to the dates selected.
        If Data(j) = Cells(i, 8) Then TST = TST + 1     ' If the date matches any of the data previously found it will trigger this condition, causing it to be passed over. The first date will always be written to data.
    Next
  
    If TST = 0 Then Data(k) = Cells(i, 8): k = k + 1    ' If this is the first time the date has been found, write to the data file.
Next
 
Worksheets("Parameters").DTE.Clear                      ' Clears old data from the Dropdown box.
Worksheets("Parameters").DELTA.Clear
 
For i = 1 To UBound(Data)                               ' This writes the new dates to the Dropdown box.
    With Worksheets("Parameters").DTE
        .AddItem Data(i)
    End With
  
    With Worksheets("Parameters").DELTA
        .AddItem Data(i)
    End With
Next
End Sub
 
Last edited by a moderator:

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
For any string, you can use VBA Left,Right to trim stuff. To remove 1 char from right:
VBA Code: 
Left(strText,Len(strText)-1)
Viceversa for left:
VBA Code: 
Right(strText,Len(strText)-1)

Sorry, I really don't know what the issue is but here is a couple tips:

1- Set names for the workbooks and/or sheets either through VBA (codename) if you are certain they won't be deleted, or set them programmatically using "Set name_here = workbook/worksheet". It will be much easy to read.

Example:
VBA Code: 
Dim wb as Workbook
Dim ws as Worksheet

Set wb = ThisWorkBook
Set wb = Workbooks("name_here")
Set ws = ActiveWorkbook.Sheets("name_here")
etc. you get the idea.

2- You can paste an array into a range in 1 go, no need to iterate with a loop, and not have to paste each cell individually. Just make sure the range is the same size as the array. Much much faster.

Example: An array of 1000x12 arrExample. Then rngExample can be, say, Range("A1").resize(1000,12)

VBA Code: 
Dim rngExample as Range

Set rngExample = Range("A1").Resize(1000,12)
rngExample.value = arrExample

3- Most of the time not necessary with VBA, but is good practise to set objects to nothing when done. i.e.,
VBA Code: 
Set rngExample = Nothing

4- A cell/range also have .Value2 and .Text properties. Value2 does not get the formatting of the cell (.Value can cause issues sometimes with rounding etc.), .Text is what you see in the cell. Maybe, you are losing the last digit here?

5- Try not to use keywords as variable/control names.

6- File System Object is the better way of handling files. You won't regret learning about it.

7- Use indents (tabs) in your code for better readability.
 
Upvote 0
Sorry for number 6, you are only saving workbooks :) Valid but unapplicable in this case.

Note: I can't seem to find an edit button?!
 
Upvote 0
@Gokhan Aycan
You will only get an edit button for 10 minutes after the original is posted.....after that it is set in stone !!
 
Upvote 0
@elmysterio89 The post wasn't directed at you....you don't need to post again.
But in future could you please use code tags when posting your code as it makes it easier to read AND Debug...:)(y)
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Copy paste columns based on matching header into another workbook
Replies
5
Views
216
mumps
mumps
O
  • Question Question
Creating workbooks for a team of staff
Replies
1
Views
200
HighAndWilder
H
K
  • Question Question
Can you please explain why this code getting error while running
Replies
2
Views
231
Joe4
Joe4
Emka
  • Question Question
Web Scrap on Chrome via VBA
Replies
0
Views
102
Emka
Emka
R
  • Question Question
VBA - AUTO FIT, Can we remove make the sum formula in below code
Replies
1
Views
157
Joe4
Joe4

Forum statistics

Threads
1,223,885
Messages
6,175,184
Members
452,615
Latest member
bogeys2birdies

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top