Need help with variables.

HansNewBie

New Member
Joined
Feb 8, 2021
Messages
6
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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...


VBA Code:
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.
 

Attachments

  • Picture.png
    Picture.png
    18.7 KB · Views: 16

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

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