EXCEL VBA - Long Value increasing within subroutines

Question

I'm having a hard time trying to see the error on the code I'm working with.

I've set a Option Explicit with a Long value (i) which is which is working as the current row. The first row is 5 so basically I'm setting 'i' as 5 to lastRow but after the 4th macro the 'i' converts from a 5 into a 9.

Explanation:

Start i = 5

checker i = 5

runall i = 5

macro1 i = 5 macro2 i = 5 macro3 i = 5 macro4 i = 9 macro5 i = 9 /runall checker /end

Code below:

Option Explicit
Dim i As Long
Dim lastRow As Long
Private Sub Worksheet_Change(ByVal Target As Range)
    lastRow = Range("F" & Rows.Count).End(xlUp).Row
    For i = 5 To lastRow
        If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("B" & i)) Is Nothing Then
            Range("C" & i).ClearContents
        End If
        If Not Intersect(Target, Range("F" & i)) Is Nothing Then
            Call Checker
        End If
        Next i
    End Sub
    Sub Checker()
        If (Range("B" & i).Text = "Insert") Then RunAll
    End Sub
    Sub RunAll()
        Call Tiers_1_to_3
        Call CI_Desc
        Call Tiers_Desc
        Call Site
        Call Support_Group_2
        Call Product_Name
    End Sub
    Sub Tiers_1_to_3()
        Range("G" & i & ":I" & i).FormulaArray = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{2,3,4},FALSE),"""")"
    End Sub
    Sub CI_Desc()
        Range("M" & i).Value = "Source"
    End Sub
    Sub Tiers_Desc()
        Range("O" & i).Formula = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,5,FALSE),"""")"
    End Sub
    Sub Site()
        Range("P" & i).Formula = _
        "=IFERROR(VLOOKUP((LEFT(DeviceInfo!RC6,3)),Automated_Data!R2C11:R334C12,2,FALSE),""Please indicate Office or Site location"")"
    End Sub
    Sub Support_Group_2()
        Range("AT" & i & ":AV" & i).FormulaArray = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{6,7},FALSE),"""")"
    End Sub
    Sub Product_Name()
        Range("J" & i).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC16,"" "",""_""))),""Please select Product Name"")"
        Range("K" & i).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC17,"" "",""_""))),""Please select Model Name"")"
    End Sub

This is giving a serious time coz I'm unable to get that line to be working on the same row, instead its going down.

The whole idea is to be working in a concatenate procedure but it's failing.

Thanks in advance for any help!

UPDATE # 1

I was able to make it run without any issues. The code works row by row, and by now I'm adding more and more values since now is more easy to understand.

Option Explicit
Option Compare Text
Const SpecialCharacters As String = "!,@,#,$,%,^,&,*,(,),{,[,],}"
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    Dim LastRow As Long
    LastRow = Range("B" & Rows.Count).End(xlUp).Row
    For i = 5 To LastRow
        If Target.Cells.Count > 1 Then Exit Sub
            If Not Intersect(Target, Range("B" & i)) Is Nothing Then
                Range("C" & i).ClearContents
            End If
        If Not Intersect(Target, Range("D" & i)) Is Nothing Then
            Range("AT" & i & ":BV" & i).ClearContents
        End If
        If Not Intersect(Target, Range("F" & i)) Is Nothing Then
            If Range("F" & i).Value Like "*[!0-9,a-z,.]*" Then
                MsgBox "Please enter proper Device Name"
                Range("F" & i).Activate
            Else
                Range("G" & i & ":I" & i).ClearContents
                Range("AT" & i & ":BV" & i).ClearContents
                Call Checker(i)
            End If
        End If
    Next i
    End Sub
Sub Checker(argi As Long)
    If (Range("B" & argi).Text = "Insert") Then
        Call Tiers_1_to_3(argi)
        Call CI_Desc(argi)
        Call Tiers_Desc(argi)
        Call Site(argi)
        Call Support_Group_2(argi)
        Call Support_Group_3(argi)
        Call Product_Name(argi)
        Call Model_Name(argi)
        Call Mgmt_Components(argi)
        Call ITSM_Group(argi)
        Call Only_Values(argi)
        Call MandatoryColors(argi)
    End If
    Range("F" & argi + 1).Select
End Sub
Sub Tiers_1_to_3(argi As Long)
    Range("G" & argi & ":I" & argi).FormulaArray = _
    "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{2,3,4},FALSE),"""")"
End Sub
Sub CI_Desc(argi As Long)
    Range("M" & argi).Value = "Source"
End Sub
Sub Tiers_Desc(argi As Long)
    Range("O" & argi).Formula = _
    "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,5,FALSE),"""")"
End Sub
Sub Site(argi As Long)
    Range("P" & argi).Formula = _
    "=IFERROR(VLOOKUP((LEFT(DeviceInfo!RC6,3)),Automated_Data!R2C11:R334C12,2,FALSE),""Please indicate Office or Site location"")"
End Sub
Sub Support_Group_2(argi As Long)
    If Range("D" & argi).Value = "Shared Fault Managed" Or Range("D" & argi).Value = "Fault Managed" Then
        Range("AT" & argi & ":AU" & argi).FormulaArray = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{6,7},FALSE),"""")"
    End If
End Sub
Sub Support_Group_3(argi As Long)
    If Range("D" & argi).Value = "Shared Fault Managed" Then
        Range("AV" & argi).Value = "NOS-NOC-CCT-OPS-LEVEL3"
    End If
End Sub
Sub Product_Name(argi As Long)
    If Range("J" & argi).Value = "" Then
        Range("J" & argi).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC16,"" "",""_""))),""Please select Product Name"")"
    Else
    End If
End Sub
Sub Model_Name(argi As Long)
    If Range("K" & argi).Value = "" Then
        Range("K" & argi).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC17,"" "",""_""))),""Please select Model Name"")"
    Else
    End If
End Sub
Sub Mgmt_Components(argi As Long)
    If Range("D" & argi).Value = "Not Managed" Then
        Range("AY" & argi).Value = "No Agent"
        Range("AZ" & argi).Value = "Not Monitored"
        Range("BA" & argi).Value = "None"
    Else
        If Range("F" & argi).Value Like "*up*" Or Range("F" & argi).Value Like "*wp*" Then
        Range("AY" & argi).Value = "ICMP Only"
        Range("AZ" & argi).Value = "Zenoss-GTN"
        Range("BA" & argi).Value = "ICMP Only"
        Else
            If Range("J" & argi).Value Like "CISCO*" Then
                Range("AY" & argi).Value = "SNMP-CNC"
                Range("BE" & argi).Value = "161"
                Range("BF" & argi).Value = "SNMP-Zenoss"
                Range("BG" & argi).Value = "Linux and Network SNMP"
                Range("BL" & argi).Value = "161"
                If Range("F" & argi).Value Like "*gdn*" Then
                    Range("AZ" & argi).Value = "Zenoss-GDN"
                    Range("BA" & argi).Value = "CNC-DCN Server"
                    Range("BC" & argi).Value = "gdcn-ch33r5Guv"
                    Range("BH" & argi).Value = "Zenoss-GDN"
                    Range("BJ" & argi).Value = "gdcn-ch33r5Guv"
                Else
                    Range("AZ" & argi).Value = "Zenoss-GTN"
                    Range("BA" & argi).Value = "CNC-GTN Server"
                    Range("BC" & argi).Value = "Z3n0ss4u"
                    Range("BH" & argi).Value = "Zenoss-GTN"
                    Range("BJ" & argi).Value = "Z3n0ss4u"
                End If
            Else
                Range("AY" & argi).Value = "SNMP-Zenoss"
                Range("BA" & argi).Value = "Linux and Network SNMP"
                Range("BE" & argi).Value = "161"
                Range("BF" & argi).Value = "SNMP"
                Range("BG" & argi).Value = "Voyence"
                Range("BL" & argi).Value = "161"
                If Range("F" & argi).Value Like "*gdn*" Then
                    Range("AZ" & argi).Value = "Zenoss-GDN"
                    Range("BC" & argi).Value = "gdcn-ch33r5Guv"
                    Range("BH" & argi).Value = "CCO"
                    Range("BJ" & argi).Value = "gdcn-ch33r5Guv"
                Else
                    Range("AZ" & argi).Value = "Zenoss-GTN"
                    Range("BC" & argi).Value = "Z3n0ss4u"
                    Range("BH" & argi).Value = "GTN-DI"
                    Range("BJ" & argi).Value = "Z3n0ss4u"
                End If
            End If
        End If
    End If
End Sub
Sub ITSM_Group(argi As Long)
    If Range("D" & argi).Value = "Fault Managed" Or Range("D" & argi).Value = "Shared Fault Managed" Then
        Range("BV" & argi).Value = "Desk"
    End If
End Sub
Sub Only_Values(argi As Long)
    Range("B" & argi & ":CE" & argi).Copy
    Range("B" & argi & ":CE" & argi).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub
Sub MandatoryColors(argi As Long)
    Dim myRange As Range
    Set myRange = Range("C" & argi & ",D" & argi & ",E" & argi & ",F" & argi & ",G" & argi & ",H" & argi & ",I" & argi & ",K" & argi & ",L" & argi & ",P" & argi & ",Q" & argi & ",R" & argi & ",S" & argi & ",T" & argi & ",U" & argi & ",V" & argi & ",W" & argi & ",X" & argi & ",Y" & argi & ",AY" & argi & ",AZ" & argi & ",BA" & argi & ",BC" & argi & ",BV5")
    If WorksheetFunction.CountA(myRange) = 0 Then
        myRange.Interior.ColorIndex = xlNone
        myRange.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 6
        MsgBox "Please complete highlighted Mandatory values"
    Else
    End If
End Sub

You might be victim of some re-entering Worksheet_change. Try Application.EnableEvents = False at entry of Worksheet_change and Application.EnableEvents = True at exit. — A.S.H

KySoto KySoto · Accepted Answer · 2016-12-27T17:28:19

From the looks of it, at some point the value i is getting changed while its calling your macros. Based on that, I'd suggest changing i to a procedure level variable instead of a module level, and then pass the value along as a parameter to the sub procedures.

    Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    Dim lastRow As Long
    lastRow = Range("F" & Rows.Count).End(xlUp).Row
    For i = 5 To lastRow
        If Target.Cells.Count > 1 Then Exit Sub
        If Not Intersect(Target, Range("B" & i)) Is Nothing Then
            Range("C" & i).ClearContents
        End If
        If Not Intersect(Target, Range("F" & i)) Is Nothing Then
            Call Checker(i)
        End If
        Next i
    End Sub
    Sub Checker( argi as long)
        If (Range("B" & argi).Text = "Insert") Then RunAll(argi)
    End Sub
    Sub RunAll(argi as long)
        Call Tiers_1_to_3(argi)
        Call CI_Desc(argi)
        Call Tiers_Desc(argi)
        Call Site(argi)
        Call Support_Group_2(argi)
        Call Product_Name(argi)
    End Sub
    Sub Tiers_1_to_3(argi as long)
        Range("G" & argi & ":I" & argi).FormulaArray = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{2,3,4},FALSE),"""")"
    End Sub
    Sub CI_Desc(argi as long)
        Range("M" & argi).Value = "Source"
    End Sub
    Sub Tiers_Desc(argi as long)
        Range("O" & argi).Formula = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,5,FALSE),"""")"
    End Sub
    Sub Site(argi as long)
        Range("P" & argi).Formula = _
        "=IFERROR(VLOOKUP((LEFT(DeviceInfo!RC6,3)),Automated_Data!R2C11:R334C12,2,FALSE),""Please indicate Office or Site location"")"
    End Sub
    Sub Support_Group_2(argi as long)
        Range("AT" & argi & ":AV" & argi).FormulaArray = _
        "=IFERROR(VLOOKUP((MID(DeviceInfo!RC6,4,2)),Automated_Data!R2C1:R46C7,{6,7},FALSE),"""")"
    End Sub
    Sub Product_Name(argi as long)
        Range("J" & argi).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC16,"" "",""_""))),""Please select Product Name"")"
        Range("K" & argi).Formula = _
        "=IFERROR((INDIRECT(SUBSTITUTE(RC17,"" "",""_""))),""Please select Model Name"")"
    End Sub

EXCEL VBA - Long Value increasing within subroutines

1 Answers