Loop column E if cell non-blank, then insert formula on other column

Ann Ooi

New Member
Joined
Jun 12, 2020
Messages
40
Office Version
  1. 365
Platform
  1. Windows
Hi, I have these VBA code that I run through each range to divide and insert if formula. Initial it has no issue, but now I have new lines, which I do not need to insert the formula if column E (Qty) is empty. And I do not know how to apply the command, if column E is non blank, then apply the rules, into current code to ensure it runs smoothly.

VBA Code:
Sub Dividefast()

Dim w2 As Worksheet
Dim m As Range
Dim lastrow1 As Long
Dim lastm As Long

Application.ScreenUpdating = False

Set w2 = Sheets("DataCompile")

On Error Resume Next

lastrow1 = w2.Cells(Cells.Rows.Count, "A").End(xlUp).Row
lastm = Range("M" & lastrow1).End(xlUp).Row + 1

For Each m In w2.Range("M" & lastm & ":M" & lastrow1)

    m.Offset(, 0).Value = m.Offset(, -6) / m.Offset(, -8)
Next
On Error GoTo 0

Application.ScreenUpdating = True

End Sub

VBA Code:
Sub FillYieldGrp()

Dim w2 As Worksheet
Dim LastRow As Long
Dim StartRow As Long

Application.ScreenUpdating = False

Set w2 = Sheets("DataCompile")

On Error Resume Next

LastRow = w2.Cells(w2.Rows.Count, 1).End(xlUp).Row
StartRow = w2.Cells(w2.Rows.Count, 14).End(xlUp).Row + 1

Dim i As Long
Dim Yield As Double
Dim Result As String

For i = StartRow To LastRow

 Yield = w2.Range("M" & i).Value
       
 If Yield >= 0.6 And Yield <= 1 Then
    Result = "'60%><=100% Yield"
    
 ElseIf Yield >= 0.3 And Yield < 0.6 Then
    Result = "'<60% Yield"
    
  Else
    Result = "'<30% Yield"
    
 End If
 
  w2.Range("N" & i).Value = Result
  
Next

Application.ScreenUpdating = True

End Sub
 

Attachments

  • Capture.JPG
    Capture.JPG
    102.5 KB · Views: 3

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,618
Office Version
  1. 2007
Platform
  1. Windows
I put your 2 macros together in a single macro. The next one goes through the entire column E and puts the result in M and N.

VBA Code:
Sub Loop_Column_E()
  Dim sh As Worksheet, i As Long
  Dim a As Variant, b As Variant
  
  Set sh = Sheets("DataCompile")
  a = sh.Range("E2:G" & sh.Range("E" & Rows.Count).End(3).Row).Value2
  ReDim b(1 To UBound(a), 1 To 2)
  
  For i = 1 To UBound(a)
    If a(i, 1) <> "" Or a(i, 1) <> 0 Then
      b(i, 1) = a(i, 3) / a(i, 1)
      Select Case b(i, 1)
        Case Is < 0.3: b(i, 2) = "'<30% Yield"
        Case Is < 0.6: b(i, 2) = "'<60% Yield"
        Case Else:     b(i, 2) = "'60%><=100% Yield"
      End Select
    End If
  Next
  
  sh.Range("M2").Resize(UBound(b), 2).Value = b
End Sub
 

Ann Ooi

New Member
Joined
Jun 12, 2020
Messages
40
Office Version
  1. 365
Platform
  1. Windows
I put your 2 macros together in a single macro. The next one goes through the entire column E and puts the result in M and N.

VBA Code:
Sub Loop_Column_E()
  Dim sh As Worksheet, i As Long
  Dim a As Variant, b As Variant
 
  Set sh = Sheets("DataCompile")
  a = sh.Range("E2:G" & sh.Range("E" & Rows.Count).End(3).Row).Value2
  ReDim b(1 To UBound(a), 1 To 2)
 
  For i = 1 To UBound(a)
    If a(i, 1) <> "" Or a(i, 1) <> 0 Then
      b(i, 1) = a(i, 3) / a(i, 1)
      Select Case b(i, 1)
        Case Is < 0.3: b(i, 2) = "'<30% Yield"
        Case Is < 0.6: b(i, 2) = "'<60% Yield"
        Case Else:     b(i, 2) = "'60%><=100% Yield"
      End Select
    End If
  Next
 
  sh.Range("M2").Resize(UBound(b), 2).Value = b
End Sub
Hi Dante,
Thank you so much, I do not know how the magic works. But it just run perfectly for my macro file. You saved my day. Wish you a great day ahead!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,618
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. You too have a good day.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,404
Messages
5,624,563
Members
416,035
Latest member
GISperson

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