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

NJT

New Member
Joined
Apr 14, 2021
Messages
4
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

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
Ok so adding a Do While Loop did not work. But an Exit For loop does.
However, the code looks really long and messy.

I was wondering if a Case Statement would clean it up or any other suggestions would be great.

Private Sub UPDATEB_Click()

Dim i As Integer
Dim s As String
Dim ws as Worksheet

Dim n as integer

Dim LastRow as integer
Dim bigValue As Integer
Dim smallValue As Integer

'Location ******************************************************
s = Me.LOCBOX.Value
Set ws = Worksheets(s)
ws.Activate
i = ItemNumBox

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For n = LastRow To 4 Step -1

bigValue = ws.Cells(n, 1).Value
smallValue = ws.Cells(n - 1, 1).Value

If i > bigValue And i > smallValue Then
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
Exit For

ElseIf bigValue > i And smallValue < i Then
n = n
Rows(n).EntireRow.Insert Shift:=xlDown
MsgBox ("row has been inserted and will be filled")
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
Exit For

' this section does not need an Exit For since it has gone through the whole loop
ElseIf bigValue > i And smallValue > i And n = 4 Then
n = n - 1
Rows(n).EntireRow.Insert Shift:=xlDown
MsgBox ("row has been inserted and will be filled")
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


Application.ScreenUpdating = True


Call UserForm_Terminate
Call UserForm_Initialize


End Sub
 
Upvote 0
Looks like repetition of same thing to me (unless my eyes playing trick on me). Can this simplification work?

Oooh. I forgot about using Integer. unless a built-in functions need Integer, I think just use Long instead. Internally, the Integer will be converted internally to Long on 64-bit Excel. Maybe can save 1/10000 sec ?
VBA Code:
Private Sub Alt_UPDATEB_Click()

Dim i As Integer
Dim s As String
Dim ws As Worksheet

Dim n As Integer

Dim LastRow As Integer
Dim bigValue As Integer
Dim smallValue As Integer

'Location ******************************************************
s = Me.LOCBOX.Value
Set ws = Worksheets(s)
ws.Activate
i = ItemNumBox

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For n = LastRow To 4 Step -1

    bigValue = ws.Cells(n, 1).Value
    smallValue = ws.Cells(n - 1, 1).Value
    
    Select Case True
        Case i > bigValue And i > smallValue
            n = n + 1
        Case bigValue > i And smallValue < i
            n = n
            Rows(n).EntireRow.Insert Shift:=xlDown
            MsgBox ("row has been inserted and will be filled")
        Case bigValue > i And smallValue > i And n = 4
            n = n - 1
            Rows(n).EntireRow.Insert Shift:=xlDown
            MsgBox ("row has been inserted and will be filled")
    End Select
    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
    Exit For
    
Next n

Application.ScreenUpdating = True

Call UserForm_Terminate
Call UserForm_Initialize

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,568
Messages
6,114,348
Members
448,570
Latest member
rik81h

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