VBA code: Loop Through Column, verify, and insert row with data

NJT

New Member
Joined
Apr 14, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Hello,

I have many sheets in my workbook. Each sheet has unique data. All the data starts at row A3 with a unique integer; A1-A2 are table headings.
When my code runs I enter a number value that is on the list. That number is searched on all the sheets and whenever it is found on a sheet the entire row gets deleted.
This is because I would like to change the data for that unique number and given the characteristics of the data will determine which sheets it goes to.

The common characteristic is that numbers are arranged from lowest to highest.

Example of number list that: 124,130,142,144,145,151,153,187,189,200 LastRow=13
When my code runs the number I choose will be deleted making the LastRow=12

VBA Code:
Dim ws as Worksheet
Dim i as integer
Dim n as long
Dim LastRow as integer

Set ws = Worksheets(s)
ws.Activate
i = ItemNumBox
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For n = LastRow To 4 Step -1

   pValue = ws.Cells(n, 1).Value
   cValue = ws.Cells(n - 1, 1).Value
 
    If i > pValue And i > cValue Then
*n=LastRow because i is bigger than all the numbers in the list
    n = n + 1
            ws.Cells(n, 1) = Me.ItemNumBox.Value
            ws.Cells(n, 3) = Me.DEPBOX.Value
            ws.Cells(n, 6) = Me.ITEMBOX.Value
            ws.Cells(n, 5) = Me.SOURBOX.Value
            ws.Cells(n, 2) = Me.DATEBOX.Value
            ws.Cells(n, 7) = Me.DODBOX.Value
            ws.Cells(n, 8) = Me.MMBOX.Value

                          If Me.MEDRB = True Then
                            ws.Cells(n, 4).Interior.ColorIndex = 46
                        ElseIf Me.LOWRB = True Then
                            ws.Cells(n, 4).Interior.ColorIndex = 6
                        Else
                            ws.Cells(n, 4).Interior.ColorIndex = 3
                        End If

   ElseIf pValue > i And cValue < i Then

        Rows(n).EntireRow.Insert Shift:=xlDown

        ws.Cells(n, 1) = Me.ItemNumBox.Value
        ws.Cells(n, 3) = Me.DEPBOX.Value
        ws.Cells(n, 6) = Me.ITEMBOX.Value
        ws.Cells(n, 5) = Me.SOURBOX.Value
        ws.Cells(n, 2) = Me.DATEBOX.Value
        ws.Cells(n, 7) = Me.DODBOX.Value
        ws.Cells(n, 8) = Me.MMBOX.Value

                      If Me.MEDRB = True Then
                        ws.Cells(n, 4).Interior.ColorIndex = 46
                    ElseIf Me.LOWRB = True Then
                        ws.Cells(n, 4).Interior.ColorIndex = 6
                    Else
                        ws.Cells(n, 4).Interior.ColorIndex = 3
                    End If
  
    ElseIf cValue > i And pValue > i And n = 4 Then
       n = n - 1
        Rows(n).EntireRow.Insert Shift:=xlDown
           ws.Cells(n, 1) = Me.ItemNumBox.Value
            ws.Cells(n, 3) = Me.DEPBOX.Value
            ws.Cells(n, 6) = Me.ITEMBOX.Value
            ws.Cells(n, 5) = Me.SOURBOX.Value
            ws.Cells(n, 2) = Me.DATEBOX.Value
            ws.Cells(n, 7) = Me.DODBOX.Value
            ws.Cells(n, 8) = Me.MMBOX.Value

                          If Me.MEDRB = True Then
                            ws.Cells(n, 4).Interior.ColorIndex = 46
                        ElseIf Me.LOWRB = True Then
                            ws.Cells(n, 4).Interior.ColorIndex = 6
                        Else
                            ws.Cells(n, 4).Interior.ColorIndex = 3
                       End If
                      
    End If
   
Next n

End Sub


The problem is once my code gets to this point: ElseIf pValue > i And cValue < i Then; then it will not get out of the loop.
I have to TroubleShoot and end task for excel.

Any insight would be fantastic

Thanks for any help in advance.
 
Last edited by a moderator:

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,147
Office Version
  1. 2016
Platform
  1. Windows
One thing would be a problem the way I see it but may not be the reason for your problem is:
During loop, you have inserted rows but your LastRow value will no more valid
 

NJT

New Member
Joined
Apr 14, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Yes you are right that is the reason i cannot exit the loop. I thought of adding a boolean but my brain cant seem to make it work.
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,147
Office Version
  1. 2016
Platform
  1. Windows
Yes you are right that is the reason i cannot exit the loop. I thought of adding a boolean but my brain cant seem to make it work.
For loop that has rows deleted and inserted, I usually use Do While row is not blank or whatever to check end of line
 

NJT

New Member
Joined
Apr 14, 2021
Messages
3
Office Version
  1. 365
Platform
  1. Windows
Ok my blank row appears when the code gets to insert. So i will add a do while loop and within that loop the data will be inserted. I will message back to let you know how it goes. Thanks for the idea.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,478
Messages
5,636,559
Members
416,923
Latest member
jarri

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top