HansNewBie
New Member
- Joined
- Feb 8, 2021
- Messages
- 6
- Office Version
- 2019
- 2016
- Platform
- 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...
The code resides in file: Destination_File_Summary.xls
Thank you very much for assistance.
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
Thank you very much for assistance.