Home > Back-end >  IF AND vba can't run when I put in a Loop
IF AND vba can't run when I put in a Loop

Time:05-22

I have a problem when executing vba code for if and in a loop. The code runs well when it's not in a loop (when I run the code one by one it give the result I want). I use ActiveCell as reference since I will use this code on another sheet with different location. Here I attach the code and picture of data, thanks in advance.

Sub cobalagi()
Dim a, b As Range
Set a = ActiveCell.Offset(0, 3)
Set b = ActiveCell.Offset(0, 4)

For I = 1 To GetBaris
    If Left(a.Value, 8) = "KML/INV/" And b.Value = "Project - cost" Then
    ActiveCell.Value = "Inv"
    Else
    ActiveCell.Value = "Bukan Inv"
    End If
    ActiveCell.Offset(1, 0).Select
    Next I
End Sub

bellow the code for GetBaris (even tho I think nothings wrong with this code)

Function GetBaris() As Long
GetBaris = Range(ActiveCell.Offset(0, 1).Address, ActiveCell.Offset(0, 1).End(xlDown).Address).Rows.Count
End Function

here the data and result of looping. first row is correct, but all the rest row sould resulting "Bukan Inv"

CodePudding user response:

I think this should solve your issues. If you have to use select then you can, but the sub runcobalagi should work. The reason you were having issues is because you kept checking against the first row, and while you're selection was checking, your offset a and b remained the same.

Try this...

Sub cobalagi()

   Call runcobalagi(AcvtiveCell)
   'or Call runcobalagi(Range("A4"))

End Sub


Private Sub runcobalagi(theStartCell As Range)
   Const a As Long = 3
   Const b As Long = 4
   Dim i As Long
   
   With theStartCell
      For i = 0 To GetBaris - 1
         If Left(.Offset(i, a).Value, 8) = "KML/INV/" And .Offset(i, b).Value = "Project - cost" Then
            
            .Offset(i, 0).Value = "INV"
          Else
            .Offset(i, 0).Value "Bukan Inv"
         End If
      
      Next i
   End With

End Sub

CodePudding user response:

Fill Column With True or False Depending on Two Conditions

Option Explicit

Sub Cobalagi()
    
    ' Source
    
    ' Column 1
    Const sCol1 As String = "D"
    Const sCrit1 As String = "KML/INV/" ' begins with
    ' Column 2
    Const sCol2 As String = "E"
    Const sCrit2 As String = "Project - cost" ' is equal
    
    ' Destination
    Const dCol As String = "A"
    Const dTrue As String = "Inv"
    Const dFalse As String = "Bukan Inv"
    
    ' Both
    Const fRow As Long = 4
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    ' Calculate the last non-empty row in column 1.
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, sCol1).End(xlUp).Row
    If lRow < fRow Then Exit Sub ' no data in row range
    
    Dim sString As String
    Dim r As Long
    Dim IsMatch As Boolean
    
    ' Loop through the rows.
    For r = fRow To lRow
        
        ' Check.
        
        ' Column 1
        sString = CStr(ws.Cells(r, sCol1).Value)
        If InStr(1, sString, sCrit1, vbTextCompare) = 1 Then ' begins with
            
            ' Column 2
            sString = CStr(ws.Cells(r, sCol2).Value)
            If StrComp(sString, sCrit2, vbTextCompare) = 0 Then ' is equal
                
                IsMatch = True

            'Else ' is not equal; do nothing i.e. 'IsMatch = False'
            End If
        
        'Else ' doesn't begin with; do nothing
        End If
        
        ' Write result.
        If IsMatch Then
            ws.Cells(r, dCol).Value = dTrue
            IsMatch = False
        Else
            ws.Cells(r, dCol).Value = dFalse
        End If
    
    Next r
            
    ' Inform.
    MsgBox "Cobalagi is done.", vbInformation

End Sub
  • Related