VBA IF Then Else Looping issues, Confused on comparing values and logic

Question

I have gone crazy with vba projects around the house and helping my wife upping her reports to the next level. I’m having troubles putting down to VBA what I’m thinking. If anyone has felt my pain please shed some light on the actual script that would help me over this hump. Summary might be comparing cell value for certain text using InStr and if doesn't exist the appending characters to the right end. I can append and run thru one cycle of the loop but get confused with trying to write the logic I'm thinking.

Alittle background on the report: One row equals one reservation. Within that row there is a column labeled “Nights”. This column is filtered for any reservation with more than “1” Night. Example: could be 3 nights, 6 nights, and 10 nights doesn’t matter. I have a macro that sorts these reservations and splits the one reservation into multiple rows totaling the number value in the “Nights” column. Basically, copying and inserting the rows next to each other. While this filtered is still applied (SpecialVisibleCells Only). Now I have another column labeled “ResNumber”. With 3, 6, or 10 rows split out the “ResNumber” column is the same number. I’m tasked with walking down this ‘ResNumber” column and appending a “-1” for the first row. A “-2” for the second reservation “-3” for the third and possibly a forth “-4” Until the last row of the copied for that one reservation group. Then the cycle (loop) starts again on the next group or block of rows. Same procedure.

Dim lnrow As Integer Dim llrow As String Dim rownuml As Integer 'row checker Dim colnuml As String 'column checker Dim count As Integer Dim total As String 'Value of reservation's "Nights" column Offset(,17) Dim startnum As Integer 'Start number for counter Dim actcell As String 'Activecell startnum = 1 With sh llrow = .Cells(.Rows.count, 2).End(xlUp).row If llrow = "" Then Exit Sub .Cells(2, 2).Resize(llrow - 1).SpecialCells(xlCellTypeVisible).Select

     For lnrow = 2 To llrow
     rownuml = ActiveCell.row
     colnuml = ActiveCell.Column
     total = ActiveCell.offset(, 17).Value

     For count = 1 To total
     rownuml = ActiveCell.row
     colnuml = ActiveCell.Column
     actcell = ActiveCell.Value

'Compares row 1 and checks resNumber value for "-1" if none exist it appends.
                   If InStr(ActiveCell.Value, "-1") = 0 Then
                        ActiveCell.Value = ActiveCell.Value & "-1"
                     Else
                     GoTo nexrow
                    End If

'Compares row 2 and checks resNumber value of above cell.
           If InStr(ActiveCell.offset(-1, 0).Value, "-1") = 0 Then
                      Resume Next
                    If InStr(ActiveCell.Value, "-2") = 0 Then
                        ActiveCell.Value = ActiveCell.Value & "-2"
                     GoTo nexrow
                    End If

'to jump out of loop nexrow 'ActiveCell moves one row down. ActiveCell.offset(1, 0).SpecialCells(xlCellTypeVisible).Select rownuml = ActiveCell.row 'just checking row number colnuml = ActiveCell.Column 'just checking column number

'since 1st reservation is already in the DB startnum starts at # 1. The counter startnum = startnum + count Next count Next End With

Error 1004 Error 1004 · Accepted Answer · 2019-04-17T07:00:25

Try:

Option Explicit

Sub test()

    Dim LastRow As Long, Times As Long, Counter As Long, i As Long, y As Long
    Dim strNumber As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

        For i = 2 To LastRow

            strNumber = .Range("B" & i).Value

            Times = Application.WorksheetFunction.CountIf(.Range("B2:B" & LastRow), strNumber)

            If Times > 1 Then

                Counter = 1

                For y = 2 To LastRow

                    If strNumber = .Range("B" & y).Value Then

                        .Range("B" & y).Value = strNumber & " - " & Counter
                        .Range("D" & y).Value = 1
                        Counter = Counter + 1

                    End If

                Next y

            End If

        Next i

    End With

End Sub

Results:

VBA IF Then Else Looping issues, Confused on comparing values and logic

1 Answers