Search code examples
vbaexcelexcel-2010excel-2007

Loop Impacting Code Output using Excel VBA


I was wondering if someone could help me debug this my code. I can't seem to figure out why when the loop moves to the second row, it changes alters the elements within the array.

For example: if the array "BookMarksToDelete" has "Dog, Cat, Bird" in it, the second loop seem to want to make it "og, Cat, Bird" in the next row.

Is there a better approach to the loop?

For Each rw In myRange.Rows
    For Each cel In rw.Cells
        For i = LBound(myArray) To UBound(myArray)
            Set oCell = myRange.Find(What:=myArray(i), LookIn:=xlValues, _
                        LookAt:=xlWhole, SearchOrder:=xlByRows, 
                        SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)

            If oCell Is Nothing Then
                sTemp = sTemp & "," & myArray(i)
            Else
                Set oCell = Nothing
            End If
        Next i

        sTemp = Mid(sTemp, 2)

        If Not Len(Trim(sTemp)) = 0 Then
            BookMarksToDelete = Split(sTemp, ",")

            Set wdApp = CreateObject("Word.Application")
            wdApp.Visible = True
            Set wdDoc = wdApp.Documents.Open(FlName)

            For i = LBound(BookMarksToDelete) To UBound(BookMarksToDelete)
                Set pRng = wdDoc.Bookmarks(BookMarksToDelete(i)).Range
                pRng.MoveEnd wdParagraph, 2
                pRng.Delete
            Next i
        End If

        Set wdTable = wdDoc.Tables(1)
        For i = LBound(BookMarksToDelete) To UBound(BookMarksToDelete)
            For Each cell In myRangeRef
                If InStr(1, cell.Value, BookMarksToDelete(i), vbTextCompare) Then 
                    aCell = cell.Offset(, -1).Value
                    stTemp = stTemp & "," & aCell
                End If
            Next cell
        Next i

        stTemp = Mid(stTemp, 2)
        If Not Len(Trim(stTemp)) = 0 Then
            ReturnsToDelete = Split(stTemp, ",")
            For i = LBound(ReturnsToDelete) To UBound(ReturnsToDelete)
                For j = wdTable.Rows.Count To 2 Step -1
                    If Left(wdTable.cell(j, 1).Range.Text, Len(wdTable.cell(j, 1).Range.Text) - 2) = ReturnsToDelete(i) Then wdTable.Rows(j).Delete
                Next j
            Next i
        End If

        With ThisWorkbook.Sheets("Investors Database")
            firstName = .Range("B" & rw)
            lastName = .Range("A" & rw)
            titleName = lastName & ", " & firstName
        End With

        Set tRng = wdDoc.Bookmarks("TitlePageName").Range
            tRng.Text = wdDoc.Bookmarks("TitlePageName").Range.Text & titleName
            wdDoc.Bookmarks.Add "TitlePageName", tRng

        d = "Information Up-To-Date as of " & Date
        Set dRng = wdDoc.Bookmarks("TitlePageDate").Range
            dRng.Text = wdDoc.Bookmarks("TitlePageDate").Range.Text & d
            wdDoc.Bookmarks.Add "TitlePageDate", dRng

        Set wRng = wdApp.ActiveDocument.Bookmarks("FundCommentary").Range
        wRng.Collapse wdCollapseStart
        wRng.InsertBreak wdPageBreak

        Set sRng = wdApp.ActiveDocument.Bookmarks("Disclaimer").Range
        sRng.Collapse wdCollapseStart
        sRng.InsertBreak wdPageBreak

        wdDoc.TablesOfContents(1).Update
        wdDoc.Repaginate

        With wdApp.ActiveDocument
            .SaveAs2 "https://websitefolder//document.docx"
            .Close
        End With

        wdApp.Visible = False

    Next
Next

Solution

  • For example: if the array "BookMarksToDelete" has Dog, Cat, Bird in it, the second loop seem to want to make it og, Cat, Bird in the next row.

    When the loop runs for the 1st time, the value of sTemp is "" so sTemp = sTemp & "," & myArray(i) adds a , at the beginning and then sTemp = Mid(sTemp, 2) trims off the , from the beginning.

    When the code loops for the 2nd time, the value of sTemp is NOT "" but your code in the next line sTemp = Mid(sTemp, 2) chops of the 1st letter.

    OPTION 1: Resetting the sTemp

    At the end of the code add the line sTemp = ""

    OPTION 2: If you do not want to reset the sTemp then check whether the 1st character is a , or not

    Replace sTemp = Mid(sTemp, 2) with If Left(sTemp, 1) = "," Then sTemp = Mid(sTemp, 2)