Macro Help

[Guest]

Hello,
Could someone please help me with a macro that will insert a row between
Groups
of Numbers. I would like to be able to insert a row between >=10000 and
<=19999,

=20000 and <=29999, >=30000 and <=39999, >=40000 and <=49999, >=50000 and<=59999 and so on upto 100000. I export this from Quickbooks and have to insert rows manually

Thanks in advance for any help

Vender Parts UPC Item Description QTY
11003
15002
17000
18000
19000
19999
20000
21000
25000
26000
26010

 

[Guest]

Mike, try this. It's setup as if your Vendor numbers are in column A. If
they are in another column, change the reference appropriately. Be sure that
the statement
Range("A3").Select
takes you to the second entry in the list of numbers (where your 15002 is in
your example) because it wants to look 1 row above that and at that row to
make the comparison. It also presumes that your list of Vendor Parts is
sorted as you have it here: in ascending order, before beginning the
operation.

Sub InsertAt10K_Intervals()
Dim LastRowUsed As Long
Dim TestValue As Long

'assumes Vendor #s in column A
LastRowUsed = Range("A" & Rows.Count).End(xlUp).Row
TestValue = 19999
Range("A3").Select ' SECOND value in list
Application.Screenupdating = FALSE
Do Until TestValue > 99999
If ActiveCell.Offset(-1,0) <= TestValue And _
ActiveCell.Value > TestValue Then
'insert blank row & update values
Selection.EntireRow.Insert
LastRowUsed=LastRowUsed + 1
TestValue = TestValue + 10000
End If
ActiveCell.Offset(1, 0).Activate
If ActiveCell.Row > LastRowUsed Then
Exit Do
End If
Loop
End Sub

 

[Guest]

Mike

Try this: I assume it is run on the active sheet and the data starts on row
2 with headings on row 1.

Option Explicit

Sub insertrows()

Const cdInc As Double = 10000
Const clRowStart As Long = 2
Dim lrow As Long
Dim dVal As Double

lrow = clRowStart
dVal = cdInc * 2

With ActiveSheet
Do While lrow < .Cells.Rows.Count
If .Cells(lrow, 1) = "" Then
Exit Sub
End If
If .Cells(lrow, 1).Value > dVal Then
.Rows(lrow - 1).Insert
dVal = dVal + cdInc
lrow = lrow + 2
Else
lrow = lrow + 1
End If
Loop
End With
End Sub

 

[Bob Phillips]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim cell As Range
Dim sh As Worksheet

Application.ScreenUpdating = False

With ActiveSheet

iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = iLastRow To 3 Step -1
If .Cells(i, TEST_COLUMN).Value \ 10000 <> _
.Cells(i - 1, TEST_COLUMN).Value \ 10000 Then
.Rows(i).Insert
End If
Next i

End With

Application.ScreenUpdating = True

End Sub

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)