Need help with variables.

[HansNewBie]

Dear forum readers,
I am having a problem with a VBA program that I wrote (Excel-VBA).

To start with some context.
I am a newbie when it comes to programming in VBA, so that been said.. 
I work in a company that uses a lot of individual files, called bricks.
All bricks (Excel-files) reside in one folder.

Each brick (individual file) has a title and subtitle (always the first and second filled row) and a type of the status of the product: (Mainstream, Emerging (R & D), Containment, Retirement).

For example:
File(s) --> Brick: Computer client operating system.xls

Content:
- Title: Client computers
- Subtitle: Operating systems

Followed by the status:
- Emerging (R & D)
o Windows 1010
o Apple IOS 398393
- Mainstream
o Windows 10
o Apple 123
- Containment
o Windows 7
- Retirement
o Windows 98
o Commodore 64
o MSX 2


I ‘wrote’ a program that:
- Reads all the Excel files in a specific folder
- Reads the title and subtitle
- Reads all rows between (for example) Mainstream and Emerging
- Puts all gathered information in ONE destination Excel-file (i.e. Title, Subtitle and information between for instance Mainstream and emerging)

So here is my/the challenge.
1. Sometimes people are filling the title and subtitle a few rows higher or lower, but it’s always (title first followed by a subtitle).
o I like to read the first and second non-blank rows.
o If someone forget to put in a title or subtitle I like to fill the variable with “No title or subtitle found”
2. Sometimes people are filling information (Emerging, Mainstream, Containment, et cetera) in column B instead or A.
o I like to fetch the information between (for example) Information and Emerging (the row), even if somebody puts the information in column B, C, D et cetera.

My ‘program’ works, but not always (sometimes it skips information/row).
And I know, it looks more like a spaghetti program, so my question is.
Can anyone help me with this challenge and provide me with some code that is easy to interpret. 

I like to add 3 attachments, but I am looking how to...

Option Explicit
Dim i As Integer
Dim Mainstream_Row As Integer
Dim Emerging_Row As Integer
Dim MainStream_Value As String
Dim Go_Vertical As Integer
Dim Value As String
Dim x As Integer
Dim Title As String
Dim SubTitle As String
Dim DestinationWB As Workbook
Dim SourceWB As Workbook
Dim strF As String, strP As String
Dim Various_wb As Workbook
Dim ws As Worksheet
Dim All_MainStream_Items As String
Dim CountY As Integer
Dim FileCount As Integer
Dim Count_strF As String
Dim rng As Range
Dim Dest_Worksheet
Dim WScriptShell



 Sub OpenClose_Excel_Files()                ' Read different Excel files and gather information to put in the summary output file
    FileCount = 0
    CountY = 1                              ' VERY IMPORTANT, otherwise the bricks will start to low.
    Set Various_wb = ActiveWorkbook         ' Make this workbook active
    Various_wb.Activate                     ' Activate Source workbook again
    Dest_Worksheet = "Output"
    strP = "C:\Temp\Excel"    ' Change for the path of your folder
    strF = Dir(strP & "\*.xlsx")            ' Change as required
    Count_strF = Dir(strP & "\*.xlsx")      ' Change as required
    '   MsgBox "Opening file " & strP & "\" & strF & ".", vbInformation, "Open File."
      
    Do While strF <> vbNullString
'        On Error Resume Next
        
        Set Various_wb = Workbooks.Open(strP & "\" & strF)
        Set ws = Various_wb.Sheets(1)   ' Uses first sheet or if all the same names then ws.Sheets("yoursheet")
        FileCount = FileCount + 1       ' Count all files in folder. When script is finished, show total number of found files.
        Call Read_Title_SubTitle        ' Sub for reading title and subtitle
        Call Get_MainStream_Emerging    ' Sub for reading all mainstream items
        Call Write_Output_Summary       ' Sub for writing all data in new sheet (summary of all information that is gathered from different sheets
  '      MsgBox "Closing file " & strP & "\" & strF & ".", vbInformation, "Close File."
        strF = Dir()
    Loop
 
  
   MsgBox "Finished the procedure." & vbNewLine & "Counted " & FileCount & " bricks", vbInformation, "Gathering bricks for status."
   Worksheets(Dest_Worksheet).Rows(1).VerticalAlignment = xlVAlignTop
   Worksheets(Dest_Worksheet).Columns("A:I").AutoFit
    
 
 End Sub
    

Sub Read_Title_SubTitle()           ' Read the Title and subtitle from each source file (Find first not blank en second non blank row)
    Worksheets("Brick").Activate    ' Activate Sheet
    x = 0
    For i = 1 To 10
        If Not Cells(i, 1) = "" Then
            Title = Range("A" & i).Value           ' Search for the FIRST value that is found in a row
            SubTitle = Range("A" & i + 1).Value    ' Search for the SECOND value that is found in a row
            x = 1
         End If
        If x = 1 Then
             GoTo lastline
        End If
        
    Next i
lastline:
'    MsgBox "Title (first now blank row) is: " & Title & vbNewLine & "Subtitle is (second non blank row): " & SubTitle, vbInformation, "Title and SubTitle"
End Sub



Sub Get_MainStream_Emerging()                   ' Get mainstream items from source files
 ' On Error Resume Next
    Worksheets("Brick").Activate                ' Activate Sheet
    
     Mainstream_Row = Application.WorksheetFunction.Match("Emerging (R & D)", Range("A1:A200"), 0)     ' Select start and end position between Mainstream (Row could be different)

     Emerging_Row = Application.WorksheetFunction.Match("Containment", Range("A1:A200"), 0) ' Select start and end position between Emerging (Row could be different)


    Do While Mainstream_Row < Emerging_Row - 1  ' Loop and read values
        Mainstream_Row = Mainstream_Row + 1
        MainStream_Value = Range("A" & Mainstream_Row).Value
        
        If MainStream_Value = Empty Then        ' In case of an empty A column
            MainStream_Value = Range("B" & Mainstream_Row).Value
        End If
    
    '    MsgBox "Mainstream_Row : " & MainStream_Value
        All_MainStream_Items = All_MainStream_Items & vbNewLine & MainStream_Value ' Summarize all rows items into one variable
    Loop

'If Err <> 0 Then
'   Set WScriptShell = CreateObject("WScript.Shell")
'    Title = "Error reading File: " & Count_strF ' Info to put in de source sheet
'    SubTitle = "Error reading File" ' Info to put in de source sheet
'    All_MainStream_Items = "Error reading File" ' Info to put in de source sheet
'    CreateObject("WScript.Shell").PopUp "Wow, what happend there?" & vbNewLine & "Please check this file for format. -> " & strF & ".", 3, "That 's not good at all!", vbExclamation
'End If
' On Error GoTo 0

End Sub
      
 
Sub Write_Output_Summary()              ' Writing all values from different Excel files to one Excel file, as a summary
    
    Various_wb.Close True
    Set SourceWB = ActiveWorkbook
    SourceWB.Activate                   ' Activate Source workbook again
        
    ' -----------------------------------------------------
    ' Setting up Lay out
    ' -----------------------------------------------------
    CountY = CountY + 1                 ' Enumerate row verticaly
    
    Range("A1:B100").Font.Size = 11
    Columns("A:C").HorizontalAlignment = xlCenter
    Cells.WrapText = True
    CountY = CountY + 1                 ' Enumerate row verticaly
    
    Set rng = Range("A" & CountY)
    With rng.Borders
        .LineStyle = xlContinuous
        .Color = vbBlack
        .Weight = xlMedium
    End With
    
    ' -----------------------------------------------------
    ' Putting information in destination file (SUMMARY)
    ' -----------------------------------------------------
    Range("A" & CountY).Interior.ColorIndex = 37
    Range("A" & CountY).Value = "File: " & strF & vbNewLine & "Title: " & Title & vbNewLine & "SubTitle: " & SubTitle & vbNewLine & All_MainStream_Items
    Range("A" & CountY).VerticalAlignment = xlTop
    CountY = CountY + 1             ' Enumarate rows verticaly
    Range("A" & CountY).Merge
    
    ' -----------------------------------------------------
    ' Clearing variables
    ' -----------------------------------------------------
    Title = ""
    SubTitle = ""
    All_MainStream_Items = ""

End Sub

The code resides in file: Destination_File_Summary.xls

Thank you very much for assistance.

 

[aRandomHelper]

Glad to help, and thanks for the feedback. Good luck!