Convert text files to excel files - excel

I developed a macro using VBA in excel to split large text files in to smaller ones, but I need those splited files to be splited in to excel type files instead of text files, currently they are being converted back to text files can anyone help on what can I do so those files are directly converted to excel instead of text ?
Appreciate it, Neyrivan Silva.

I'm not sure what your end game is, but this should help you get started.
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Public Function ChDirNet(szPath As String) As Boolean
'based on Rob Bovey's code
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
ChDirNet = CBool(lReturn <> 0)
End Function
Sub Get_TXT_Files()
'For Excel 2000 and higher
Dim Fnum As Long
Dim mysheet As Worksheet
Dim basebook As Workbook
Dim TxtFileNames As Variant
Dim QTable As QueryTable
Dim SaveDriveDir As String
Dim ExistFolder As Boolean
'Save the current dir
SaveDriveDir = CurDir
'You can change the start folder if you want for
'GetOpenFilename,you can use a network or local folder.
'For example ChDirNet("C:\Users\Ron\test")
'It now use Excel's Default File Path
ExistFolder = ChDirNet("C:\your_path_here\")
If ExistFolder = False Then
MsgBox "Error changing folder"
Exit Sub
End If
TxtFileNames = Application.GetOpenFilename _
(filefilter:="TXT Files (*.txt), *.txt", MultiSelect:=True)
If IsArray(TxtFileNames) Then
On Error GoTo CleanUp
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Add workbook with one sheet
Set basebook = Workbooks.Add(xlWBATWorksheet)
'Loop through the array with txt files
For Fnum = LBound(TxtFileNames) To UBound(TxtFileNames)
'Add a new worksheet for the name of the txt file
Set mysheet = Worksheets.Add(After:=basebook. _
Sheets(basebook.Sheets.Count))
On Error Resume Next
mysheet.Name = Right(TxtFileNames(Fnum), Len(TxtFileNames(Fnum)) - _
InStrRev(TxtFileNames(Fnum), "\", , 1))
On Error GoTo 0
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & TxtFileNames(Fnum), Destination:=Range("A1"))
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
'This example use xlDelimited
'See a example for xlFixedWidth below the macro
.TextFileParseType = xlDelimited
'Set your Delimiter to true
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
'Set the format for each column if you want (Default = General)
'For example Array(1, 9, 1) to skip the second column
.TextFileColumnDataTypes = Array(1, 9, 1)
'xlGeneralFormat General 1
'xlTextFormat Text 2
'xlMDYFormat Month-Day-Year 3
'xlDMYFormat Day-Month-Year 4
'xlYMDFormat Year-Month-Day 5
'xlMYDFormat Month-Year-Day 6
'xlDYMFormat Day-Year-Month 7
'xlYDMFormat Year-Day-Month 8
'xlSkipColumn Skip 9
' Get the data from the txt file
.Refresh BackgroundQuery:=False
End With
ActiveSheet.QueryTables(1).Delete
Next Fnum
'Delete the first sheet of basebook
On Error Resume Next
Application.DisplayAlerts = False
basebook.Worksheets(1).Delete
Application.DisplayAlerts = True
On Error GoTo 0
CleanUp:
ChDirNet SaveDriveDir
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End Sub

Related

How can I import excel sheets in the way I am importing csv ones using VBA?

I currently have this code for importing multiple .csv files, where if the file name matches an existing sheet in my excel file, then the content will be automatically pasted into it. And if not in creates a tab with the exact same name.
I was wondering if by any chance could I replace the QueryTables command used to import the data from a .csv file and use something similar for .xlsx files.
Thank you
PS: it would be to modify mainly te importCSV part. For now I won’t be needing anymore csv formats.
It was just to explain the logic of the importing method. I need something to allow me to import data coming from multiple xlsx into the corresponding Tab in my master excel. Thankss!
Sub CopyCSVfiles()
Dim naming As Object
Dim xlsheet As Worksheet
Dim qt As QueryTable
Dim txtfilesToOpen As Variant, txtfile As Variant
Application.ScreenUpdating = False
Set Name = CreateObject("Scripting.FileSystemObject")
txtfilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.csv), *.csv", _
MultiSelect:=True, Title:="Text Files to Open")
For Each txtfile In txtfilesToOpen
' Here we find if there is an already existing worksheet
For Each xlsheet In ThisWorkbook.Worksheets
If xlsheet.Name = Replace(naming.GetFileName(txtfile), ".csv", "") Then
xlsheet.Activate
GoTo ImportCSV
End If
Next xlsheet
' CREATES A NEW WORKSHEET IF NOT FOUND
Set xlsheet = ThisWorkbook.Worksheets.Add( _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
xlsheet.Name = Replace(naming.GetFileName(txtfile), ".csv", "")
xlsheet.Activate
GoTo ImportCSV
ImportCSV:
' DELETE EXISTING DATA
ActiveSheet.Range("A:Z").EntireColumn.Delete xlShiftToLeft
' IMPORT DATA FROM TEXT FILE
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & txtfile, _
Destination:=ActiveSheet.Cells(1, 1))
.TextFileParseType = xlDelimited
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.Refresh BackgroundQuery:=False
End With
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next qt
Next txtfile
Application.ScreenUpdating = True
MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"
Set naming = Nothing
End Sub
For copy the information from a CSV file and put it in an Excel Worksheet, directly from VBA, you can take advantage of this project. If you don't know how to start with the utility, read the installation instructions.
Replace the following code:
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & txtfile, _
Destination:=ActiveSheet.Cells(1, 1))
.TextFileParseType = xlDelimited
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.Refresh BackgroundQuery:=False
End With
For Each qt In ActiveSheet.QueryTables
qt.Delete
Next qt
with a call to this procedure:
Sub ImportCSVRecords(filePathAndName As String, OutputSheet As String, OutputRange As String)
Dim CSVix As CSVinterface
Set CSVix = New CSVinterface 'Create new instance
Call CSVix.OpenConnection(filePathAndName) 'Open a physical connection to the CSV file
Call CSVix.ImportFromCSV 'Import data
Call CSVix.DumpToSheet(WBookName:=ThisWorkbook.Name, SheetName:=OutputSheet, rngName:=OutputRange) 'Dumps the data to the current Workbook's OutputSheet starting at named OutputRange.
Set CSVix = Nothing 'Terminate the current instance
End Sub

Excel VBA HTML Import Formatting

I have been using the below vba from another thread and have modified it to allow html vs txt.
When it imports the HTML it works fine but the html is spread out over multiple rows and not contained to one cell.
Is there a way to restrict the html to once cell only?
I need all the html to be in one cell as I need to process about 500 html files regularly and i just require it to be in individual cells.
Any help appreciated.
Sub ImportTXTFiles()
Dim FSO As Object
Dim xlsheet As Worksheet
Dim qt As QueryTable
Dim txtfilesToOpen As Variant, txtfile As Variant
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
txtfilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.html), *.html", _
MultiSelect:=True, Title:="HTML Files to Open")
With ActiveSheet
For Each txtfile In txtfilesToOpen
importrow = 1 + .Cells(.Rows.Count, 1).End(xlUp).Row
' IMPORT DATA FROM TEXT FILE
With .QueryTables.Add(Connection:="TEXT;" & txtfile, _
Destination:=.Cells(importrow, 1))
.TextFileParseType = xlDelimited
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "$"
.Refresh BackgroundQuery:=False
End With
Next txtfile
For Each qt In .QueryTables
qt.Delete
Next qt
End With
Application.ScreenUpdating = True
MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"
Set FSO = Nothing
End Sub
Try the next code, please:
Sub ImportTXTFiles()
Dim FSO As Object, txtStr As Object, strText As String, sh As Worksheet
Dim txtfilesToOpen As Variant, txtfile As Variant, importrow As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Set sh = ActiveSheet ' use here your sheet
txtfilesToOpen = Application.GetOpenFilename _
(FileFilter:="Text Files (*.html), *.html", _
MultiSelect:=True, Title:="HTML Files to Open")
For Each txtfile In txtfilesToOpen
importrow = 1 + sh.cells(Rows.count, 1).End(xlUp).Row
Set txtStr = FSO.OpenTextFile(txtfile)
strText = txtStr.ReadAll
txtStr.Close
If Len(strText) <= 32000 Then
sh.cells(importrow, 1).Value = strText:
Else
MsgBox txtfile & " size exceeds the limit of 32000 digits..."
End If
Next txtfile
MsgBox "Successfully imported text files!", vbInformation, "SUCCESSFUL IMPORT"
Set FSO = Nothing
End Sub
It checks the limit of a cell string size (32k characters) and rise a message for such a case... If necessary, it can split the string in portions of 32k and paste in the next cells, marking in B:B 1, 2 ... x portion numbers...

Excel VBA - Error Parsing Dates, Handling Strings

The problem I have concerns a CSV file that I am seeking to parse into an excel spreadsheet.
An example of the data is as follows:-
01/02/2015,MXP,0.4,150.00,Producing design document, 64111258
02/06/2015,IHM,0.8,210.00,"Maximilian dolce, lorem ipsum", 64111258
02/06/2015,AXSP,0.6,250.00,"Magnificent, thanks very much", 64111258
Currently, this is the code I am using to parse the data:-
Sub OpenCSV()
Dim filePath As String
Dim intChoice As Integer
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show
rowIndex = 0
If intChoice <> 0 Then
filePath = Application.FileDialog( _ msoFileDialogOpen).SelectedItems(1)
Open filePath For Input As #1
Do Until EOF(1)
Line Input #1, LineFromFile
LineItem = Split(LineFromFile, ",")
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 0).Value = LineItem(0) ' Date
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 1).Value = LineItem(1) ' Code
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 2).Value = LineItem(2) ' Hours
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 3).Value = LineItem(3) ' Cost
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 4).Value = LineItem(4) ' Description
rowIndex = rowIndex + 1
Loop
Close #1
End If
End Sub
The issues are as follows:-
Dates such as 02/06/2015 which are parsed and transposed to the excel cell will end up as 06/02/2015. This will not happen consistently, but happens randomly to various dates within the dataset.
CSV delimiter 4 will end up being parsed incorrectly where "" are in the data, as well as comma; Consequently the data is not transposed correctly to the relevant cell.
How can I go about correcting these errors?
Something like this should work for you:
Sub tgr()
Dim wb As Workbook
Dim wsDest As Worksheet
Dim sFilePath As String
Dim aData As Variant
sFilePath = Application.GetOpenFilename("CSV Files, *.csv", MultiSelect:=False)
If sFilePath = "False" Then Exit Sub 'Pressed cancel
Set wb = ActiveWorkbook
Set wsDest = wb.Sheets("Sheet2")
Application.ScreenUpdating = False
With Workbooks.Open(sFilePath)
aData = .Sheets(1).Range("A1", .Sheets(1).Cells(.Sheets(1).Rows.Count, "E").End(xlUp)).Value
.Close False
End With
Application.ScreenUpdating = True
With wsDest.Range("B11").Resize(UBound(aData, 1), UBound(aData, 2))
.Value = aData
.Resize(, 1).NumberFormat = "mm/dd/yyyy" 'Can set date format here, change to dd/mm/yyyy if needed
End With
End Sub
Most likely, the issue is a mismatch between the date format of your data and your Windows Regional Settings. Several ways to handle this
Change your Windows Regional Settings so they match
Change the file type to a *.txt file. Then use the Workbooks.OpenText method which allows you to specify the date column data type.
Create a Data Connection which will also allow you to do the same. Just be sure that you don't keep creating QueryTables. It the table is already there, either delete and recreate, or refresh.
Here is some code demonstrating the QueryTable method. In the Excel GUI this would be the Data ► Get External Data ► From text option
Option Explicit
Sub OpenCSV()
Dim filePath As String
Dim intChoice As Integer
Dim WS As Worksheet
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show
If intChoice <> 0 Then
filePath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)
Set WS = Worksheets("sheet2")
With WS.QueryTables
'If it exists, either delete and re-import or refresh
If .Count > 0 Then
Range(.Item(1).Destination.Address).CurrentRegion.Delete
.Item(1).Delete
End If
End With
'
With WS.QueryTables.Add(Connection:="TEXT;" & filePath, Destination:=WS.Range("$B$11"))
.Name = "New Text Document"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
'make sure format argument matches format in the csv file
.TextFileColumnDataTypes = Array(xlDMYFormat)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
End Sub
Dim arr() As String
Dim newDate As Date
arr = Split(LineItem(0), "/")
newDate = DateSerial(Year:=arr(2), Month:=arr(1), Day:=arr(0))
Then use
Sheets("Sheet2").Cells(11, 2).Offset(rowIndex, 0).Value = newDate

Importing data from .csv to excel document using VBA

wondering if you can help out with a VBA issue. I pieced together the following without really knowing what I was doing:
Sub Import_Raw_Stripe_data()
Dim fileDialog As fileDialog
Dim strPathFile As String
Dim strFileName As String
Dim strPath As String
Dim dialogTitle As String
Dim Tworkbook As Workbook
Dim Sworkbook As Workbook
dialogueTitle = "Select File to Import"
Set fileDialogue = Application.fileDialog(msoFileDialogFilePicker)
With fileDialogue
.InitialFileName = "L:\Downloads"
.AllowMultiSelect = False
.Filters.Clear
.Title = dialogueTitle
If .Show = False Then
MsgBox "No file selected."
Exit Sub
End If
strPathFile = .SelectedItems(1)
End With
Set Sworkbook = Workbooks.Open(fileName:=strPathFile)
Set Tworkbook = ThisWorkbook
End Sub
Which, as far as I can tell opens a file dialog in excel, allows a user to choose a document and then opens it.
What I would like to do is the following:
1) Open a file dialogue and select a .csv file to import data from (complete?) into a .xlsm master file (with multiple sheets).
2) Select certain columns from the .csv (column A, Q, R and S in this case), copy them and import them into the second sheet of the master excel file entitled "Raw Stripe Data".
Any help in the matter would be greatly appreciated.
Update: I managed to find the following code:
Sub load_csv()
Dim fStr As String
With Application.fileDialog(msoFileDialogFilePicker)
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Cancel Selected"
Exit Sub
End If
'fStr is the file path and name of the file you selected.
fStr = .SelectedItems(1)
End With
With ThisWorkbook.Sheets("Stripe Raw Data").QueryTables.Add(Connection:= _
"TEXT;" & fStr, Destination:=ThisWorkbook.Sheets("Stripe Raw Data").Range("$A$1"))
.Name = "CAPTURE"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
ActiveWorkbook.Save
End With
End Sub
This works great - but is there anyway to have it not override the data already imported? (for example, if i use it twice, the second import overrides the first).
ThisWorkbook.Sheets("Stripe Raw Data").Range("$A$1") specifies where the imported data is written to, that is the first cell of the sheet Stripe Raw Data.
Adapt this to your liking if you want the next import at another location.
As mentioned in the comments, you could change load_csv() to take the output destination as a parameter. If you also change it from Sub to Function, you can return the number of rows imported:
Function load_csv(rngDestination As Range) As Long
'...
With ThisWorkbook.Sheets("Stripe Raw Data").QueryTables.Add(Connection:= _
"TEXT;" & fStr, Destination:=rng)
'...
.Refresh BackgroundQuery:=False
load_csv = .ResultRange.Rows.Count
'...
End Function
Now you can repeatedly call load_csv and provide it with the range where the output should begin for example:
Dim rngOutput As Range
Dim lngRows As Long
Set rngOutput = ThisWorkbook.Sheets("Stripe Raw Data").Range("$A$1")
lngRows = load_csv(rngOutput) ' load first file
lngRows = lngRows + load_csv(rngOutput.Offset(lngRows)) ' load second file
lngRows = lngRows + load_csv(rngOutput.Offset(lngRows)) ' load third file
lngRows = lngRows + load_csv(rngOutput.Offset(lngRows)) ' load fourth file
There is still much room for improvement:
Removing duplicate headers
Creating a loop instead of explicitly calling load_csv four times
Better control for the user to select files (multiselect)
Disconnecting the imported data from the QueryTable to reduce dependencies even after the import
Not importing in ThisWorkbook but afterwards saving ActiveWorkbook - they may not always be the same
...
But that's not part of this question. After all, all you wanted to know was:
is there anyway to have it not override the data already imported?
I hope I could sufficiently answer this with the above.

Creating a new table in a new worksheet with maximum column values from other worksheets

Good evening, I am trying to load number of csv files and then calculate the max of each column from Column E to the last column (last column can be different for each run) and paste the values in a new work sheet.
I have tried to break my coading down in stages as I am learning VBA:
Step 1. Code to open folder select dialogue box and load each text files to excel in different worksheets with file name
Step 2. Code to open new worksheet and name as “Result”
with some sample data step 1 and 2 look like this [figure 1]:
and finally
Step 3. Code to find the maximum value for column E to last column and paste in the result sheet with the year number and the heigh number from the worksheet name, for example as follows:
So far with the help of this forum I have managed to create procedures with a simple userform with a run button that look like this:
I have manged to complete Step 1 and Step 2 (please see my codes below) but now really stuck with Step 3.
So far for step 3 I have managed to write something that can calculate max for column ‘E’ but just could not figure out how to calculate for all columns from column ‘E’ onwards for each work sheet and paste to the result sheet. I can calculate the col E max using the following code but the 5th line on the code do not copy to other columns:
Sub SumData()
Dim lastrow As Long
lastrow = Range("A1").End(xlDown).Row
Cells(lastrow + 2, "E").Formula = "=MAX(E2:E" & lastrow & ")"
Cells(lastrow + 2, "E").AutoFill , Type:=xlFillDefault
End Sub
I would really appreciate any advise with my step 3 and to make you understand easier I have copied my sample csv files in the following drop box link:
https://www.dropbox.com/sh/hqhzd901vwlgbl9/AAApxVc_CAsESxR9iZ4cHoOua?dl=0
The codes that I have created for step 1 and 2 are below and working for me:
Private Sub FilePath_Button_Click()
get_folder
End Sub
Private Sub Run_Button_Click()
load_file
End Sub
Public Sub get_folder()
Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
FolderName = .SelectedItems(1)
Err.Clear
On Error GoTo 0
End With
TextBox1.Text = FolderName
End Sub
Sub load_file()
Dim strFile As String
Dim WS As Worksheet
Dim test As String
Dim wb As Workbook
test = TextBox1.Text
strFile = Dir(Me.TextBox1.Text & "\*.plt")
Set wb = Workbooks.Add
'added workbook becomes the activeworkbook
With wb
Do While Len(strFile) > 0
Set WS = ActiveWorkbook.Sheets.Add
WS.Name = strFile
With WS.QueryTables.Add(Connection:= _
"TEXT;" & test & "\" & strFile, Destination:=Range("$A$1"))
.Name = strFile
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
strFile = Dir
Loop
End With
Dim WS2 As Worksheet
Set WS2 = Sheets.Add
Sheets.Add.Name = "Result"
MsgBox "Job Complete"
End Sub
Private Sub UserForm_Click()
End Sub
There may lot simpler way of writing the codes but this is the best I could come up with for step 1 and 2. Many thanks in advance!
If all the worksheet names has the same format i.e XXX_XXX_XX_XXXX then it is pretty simple to extract those values. You can use Split function. here is an example
Sub Sample()
Dim sName(1 To 4) As String
Dim i As Long
sName(1) = "HP5_1gt_60_2010"
sName(2) = "HP5_1gt_70_2010"
sName(3) = "HP5_1gt_100_2008"
sName(4) = "HP5_1gt_110_2008"
For i = 1 To 4
Debug.Print "Height --> " & Split(sName(i), "_")(2)
Debug.Print "Year --> " & Split(sName(i), "_")(3)
Debug.Print "-----"
Next i
End Sub
Output
And to find the maximum value in a column, you can use the Max worksheet function in VBA. here is an example
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Sheets("Sheet1")
Set rng = ws.Columns(5)
Debug.Print Application.WorksheetFunction.Max(rng)
End Sub
Output

Resources