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
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