Vba loop only when cells are not blank

Heather515

New Member
Joined
Sep 11, 2021
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Data.xlsx
D
6
Sheet1


I need help with making my code more efficient. As you can see, I want to code "Apple" as "1", and everything else as "0". However, I want to leave other cells blank when the cells in the first column is also blank. My current code first return 1 for Apple and 0 for others (including blank cells), and then I run the loop to remove 0 generated from the first step. It takes too long to remove the unwanted zeros since I have hundreds of thousands rows. I also need to keep the blank rows for merging data later.

Could you please help change my code or write a new code so cells with "Apple" return value of "1" and only other non-blank cells return value of "0" so I don't need to spend extra time to remove the unwanted zeros. Thanks!


Sub Apple()

Dim LRow As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row

For x = 2 To LRow

If InStr(Cells(x, 1), "Apple") > 0 Then
Cells(x, 2) = "1"
Else
Cells(x, 2) = "0"
End If
Next x

For x = 2 To LRow

If IsEmpty(Cells(x, 1)) Then

Cells(x, 2) = ""

End If

Next x


End Sub
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
38,034
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Does this work with your actual data...
VBA Code:
Sub Apples()
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .SpecialCells(xlConstants).Offset(, 1) = 0
    .Offset(, 1) = Evaluate(Replace("IF(@="""","""",0+ISNUMBER(SEARCH(""apple"",@)))", "@", .Address))
  End With
End Sub
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Heather515

New Member
Joined
Sep 11, 2021
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Try this...

VBA Code:
Sub Heather515B()
    Dim i As Long, j As Long, ws As Worksheet, arrIn, arrOut
    Set ws = ActiveSheet
    i = ws.Cells(Rows.Count, 1).End(xlUp).Row
    arrIn = ws.Range(ws.Cells(2, 1), ws.Cells(i, 2))
    ReDim arrOut(1 To UBound(arrIn), 1 To 1)

    For j = 1 To i - 1
        If arrIn(j, 1) Like "*apple*" Then
            arrOut(j, 1) = 1
            ElseIf arrIn(j, 1) = "" Then
            arrOut(j, 1) = ""
            Else
            arrOut(j, 1) = 0
        End If
    Next j
    ws.Range("B2").Resize(UBound(arrOut)).Value = arrOut
End Sub
Thank you very much. It works perfectly!
 

Heather515

New Member
Joined
Sep 11, 2021
Messages
22
Office Version
  1. 365
Platform
  1. Windows
Does this work with your actual data...
VBA Code:
Sub Apples()
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .SpecialCells(xlConstants).Offset(, 1) = 0
    .Offset(, 1) = Evaluate(Replace("IF(@="""","""",0+ISNUMBER(SEARCH(""apple"",@)))", "@", .Address))
  End With
End Sub
Does this work with your actual data...
VBA Code:
Sub Apples()
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .SpecialCells(xlConstants).Offset(, 1) = 0
    .Offset(, 1) = Evaluate(Replace("IF(@="""","""",0+ISNUMBER(SEARCH(""apple"",@)))", "@", .Address))
  End With
End Sub
Thanks. It works!
 

Forum statistics

Threads
1,176,168
Messages
5,901,734
Members
434,914
Latest member
mabek

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
Top