tokyo_north
tokyo_north

Reputation: 125

Most efficient way to loop thru a column searching for a specific values

I have some code that I want to search thru a row of column names (row 7) and identify whether or not the column name is part of a list I have. If it detects that it is part of the list, then it will go down that column and convert the formulas to values by doing Sheet.Range.Value=Sheet.Range.Value.

For example, if it detects the word Apple or Banana, it will loop thru the column and convert the formulas into values.

However, I have found that this probably isn't the most efficient way to achieve this. I have the code listed below. Does anyone know how to make this more efficient?

Dim lastcol, lastrow As Long

    lastcol = Sheets("Sheet1").Cells(7, Columns.Count).End(xlToLeft).Column
    lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    Dim z
    For i = 5 To lastcol
        If Sheets("Sheet1").Cells(7, i).value = "Banana" Then
            For z = 9 To lastrow
                Sheets("Sheet1").Cells(z, i).value = Sheets("Sheet1").Cells(z, i).value
            Next z
        End If
        If Sheets("Sheet1").Cells(7, i).value = "Apple" Then
            For z = 9 To lastrow
                Sheets("Sheet1").Cells(z, i).value = Sheets("Sheet1").Cells(z, i).value
            Next z
        End If
        If Sheets("Sheet1").Cells(7, i).value = "Coconut" Then
            For z = 9 To lastrow
                Sheets("Sheet1").Cells(z, i).value = Sheets("Sheet1").Cells(z, i).value
            Next z
        End If
        If Sheets("Sheet1").Cells(7, i).value = "Kiwi" Then
            For z = 9 To lastrow
                Sheets("Sheet1").Cells(z, i).value = Sheets("Sheet1").Cells(z, i).value
            Next z
        End If
        If Sheets("Sheet1").Cells(7, i).value = "Watermelon" Then
            For z = 9 To lastrow
                Sheets("Sheet1").Cells(z, i).value = Sheets("Sheet1").Cells(z, i).value
            Next z
        End If
        If Sheets("Sheet1").Cells(7, i).value = "Orange" Then
            For z = 9 To lastrow
                Sheets("Sheet1").Cells(z, i).value = Sheets("Sheet1").Cells(z, i).value
            Next z
        End If
    Next i

Upvotes: 0

Views: 70

Answers (3)

Acccumulation
Acccumulation

Reputation: 3591

If you store your list as an array on a sheet, then there are a variety of ways of testing whether something is in the list.

A1 = apple A2 = banana A3 = missing B1 = TRUE B2 = TRUE B3 = FALSE

=ISNUMBER(MATCH("apple",A1:A2,0)) returns TRUE

=ISNUMBER(MATCH("orange",A1:A2,0)) returns FALSE

=vlookup("apple",A1:A3,1)="apple" returns TRUE.

=vlookup("orange",A1:A3,1)="orange" returns FALSE.

=not(vlookup("apple",A1:A3,1)="missing") returns TRUE.

=not(vlookup("orange",A1:A3,1)="missing") returns FALSE.

=vlookup("apple",A1:B3,2) returns TRUE.

=vlookup("orange",A1:B3,2) returns FALSE.

Upvotes: 0

BruceWayne
BruceWayne

Reputation: 23283

You could use an array, and check the value of the array.

This is a little longer than @JustynaMK's answer, but I was working on it before they posted their, so figure I'll go ahead and post.

Option Explicit

Sub replace_formulas()
Dim keys() As Variant
Dim keyWords As String

Dim ws As Worksheet
Set ws = Worksheets("Sheet1")

keys = Array("Banana", "Apple", "Coconut", "Kiwi", "Watermelon", "Orange")
keyWords = joinArray(keys, "#")

Dim headerRow As Long, startCol As Long
headerRow = 7
startCol = 5

Dim lastCol As Long, lastRow As Long
lastCol = ws.Cells(headerRow, Columns.Count).End(xlToLeft).Column
' I changed this to Column 5 to get the lastRow, but change as needed
lastRow = ws.Cells(Rows.Count, startCol).End(xlUp).Row

Dim headers As Range
Set headers = ws.Range(ws.Cells(headerRow, startCol), ws.Cells(headerRow, lastCol))

Dim cel As Range
With ws
    For Each cel In headers
        If InStr(1, keyWords, "#" & cel.Value & "#", vbTextCompare) Then
            .Range(.Cells(headerRow, cel.Column), .Cells(lastRow, cel.Column)).Value = _
            .Range(.Cells(headerRow, cel.Column), .Cells(lastRow, cel.Column)).Value
        End If
    Next cel
End With

End Sub

Function joinArray(arr As Variant, delim As String) As String
'https://stackoverflow.com/a/11112615/4650297
Dim strg As String
strg = Join(arr, delim)
joinArray = delim & strg
End Function

Upvotes: 1

Justyna MK
Justyna MK

Reputation: 3563

You can use an array of search words (arrWords) as an alternative solution, and then check if a given header (Cells(7,i).Value) belongs to this array (Application.Match):

Sub foo()
    Dim lastcol As Long, lastrow As Long, z As Long
    Dim arrWords As Variant

    arrWords = Array("Banana", "Apple", "Coconut", "Kiwi", "Watermelon", "Orange")
    lastcol = Sheets("Sheet1").Cells(7, Columns.Count).End(xlToLeft).Column
    lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 5 To lastcol
        If Not IsError(Application.Match(Sheets("Sheet1").Cells(7, i).Value, arrWords, 0)) Then
            For z = 9 To lastrow
                Sheets("Sheet1").Cells(z, i).Value = Sheets("Sheet1").Cells(z, i).Value
            Next z
        End If
    Next i
End Sub

Edit:

As per Bruce's suggestion, you can also replace your whole For z = 9 to lastrow ... Next z loop with one line:

Sheets("Sheet1").Range(Cells(9, i), Cells(lastrow, i)).Value = Sheets("Sheet1").Range(Cells(9, i), Cells(lastrow, i)).Value

Upvotes: 3

Related Questions