Excel VBA - Looking for ways to simplify loop - vba

Question

I recently made a loop that takes the string in each cell, searches for a "_" in the string, and if there is one cuts off that bit and any character after it. Looking at the code I realized it might be too elaborate and could be shortened or simplified, but I'm not quite sure how to do so. Is there a way to make this bit of code more efficient?
Sub Name_Change()
Sheets("Sheet1").Activate
Dim tg_row As Integer
tg_row = 1
For Each nm_cl In Range("Table1[Name]")
If InStr(1, nm_cl, "_", vbTextCompare) = 0 Then
Range("Table1[Name]").Cells(tg_row, 1).Value = nm_cl.Value
Else
Range("Table1[Name]").Cells(tg_row, 1) = _
Left(nm_cl, InStr(1, nm_cl, "_", vbTextCompare) - 1)
End If
tg_row = tg_row + 1
Next nm_cl
End Sub
Thank you for your help!

Answer 1

A first attempt at optimizing this would be to note that you are calling InStr multiple times. You can speed things up by computing it once, and storing the result.
Along with that I would note that presumably Range("Table1[Name]") only has one column (otherwise you would be overwriting the first column with data from the other columns). So, you can replace Range("Table1[Name]").Cells(tg_row, 1) with nm_cl. In doing this, we notice the redundant statement of nm_cl.Value = nm_cl.Value can be removed. This leads to the following code:
Sub Name_Change()
Sheets("Sheet1").Activate
Dim index As Long
For Each nm_cl In Range("Table1[Name]")
index = InStr(1, nm_cl, "_", vbTextCompare)
If index <> 0 Then
nm_cl = Left(nm_cl, index - 1)
End If
Next nm_cl
End Sub
If you need more efficiency, beyond this, you can load your data into a variant by using
dim data as Variant
data = Range("Table1[Name]").Value
process all of your data within VBA, and then put it back to the worksheet using
Range("Table1[Name]").Value = data
This will increase your speed, as transfering data between Excel and VBA is slow and this means you will have 1 read and 1 write, instead of 1 read and 1 write per line, but it will require a (minor) rewrite of your algorithm as the syntax for working with an array within a variant is different from working with ranges. Note that this will not work if you go beyond the 65536 rows. I beleive that it is a legacy constraint from Excel 2003 and earlier.

Answer 2

You could adjust your loop to only modify the cells that contain "_".
If Not InStr(1, nm_cl, "_", vbTextCompare) = 0 Then
Range("Table1[Name]").Cells(tg_row, 1) = _
Left(nm_cl, InStr(1, nm_cl, "_", vbTextCompare) - 1)
End If
EDIT:
Here's a working example that includes #Degustaf's suggestions. Just change the name of the range to fit your worksheet.
Sub Name_Change()
Dim selectedRange As Range
Dim rangeData As Variant 'Array containing data from specified range
Dim col As Long 'Selected column from range
Dim row As Long 'Selected row from range
Dim cellValue As String 'Value of selected cell
Dim charPosition As Long 'Position of underscore
Sheets("Sheet1").Activate
Set selectedRange = Range("YOUR-NAMED-RANGE-HERE")
If selectedRange.Columns.Count > 65536 Then
MsgBox "Too many columns!", vbCritical
ElseIf selectedRange.Rows.Count > 65536 Then
MsgBox "Too many rows!", vbCritical
Else
rangeData = selectedRange.Value
If UBound(rangeData, 1) > 0 And UBound(rangeData, 2) > 0 Then
'Iterate through rows
For row = 1 To UBound(rangeData, 1)
'Iterate through columns
For col = 1 To UBound(rangeData, 2)
'Get value of cell
cellValue = CStr(rangeData(row, col))
'Get position of underscore
charPosition = InStr(1, cellValue, "_", vbTextCompare)
'Update cell data stored in array if underscore exists
If charPosition <> 0 Then
rangeData(row, col) = Left(cellValue, charPosition - 1)
End If
Next col
Next row
'Overwrite range with array data
selectedRange.Value = rangeData
End If
End If
End Sub

Answer 3

You could use a user defined function to return the truncated strings in cells.
The Worksheet-function could look like:
Public function truncateAt( s as String) as string
dim pos as integer
pos = instr (1, s,"_")
If pos> 0 then
truncateAt= left (s, pos)
Else
truncateAt= s
End If
End function