Reduce a value by spliting the data

[Kev]

Hi
I'm trying to get a sheet to work, It resizes the row's depending on a
value in a range, but to prevent errors happening
I want to split the item by coping & posting the data and altering
the value. I've got this code to work but how do I get it to carry on
untill the values are below 40, currently it works for a value of 75

kev

Sub checksize()
Range("f4:J152").Select
For Each Item In Selection

If Item >= 40 Then
With Item
Range("A" & Item.Row & ":" & "v" & Item.Row).Select
Item.Value = Item.Value - 35
Selection.Copy
Selection.Insert Shift:=xlDown
Item.Value = 35
MsgBox ("Item " & Item.Row - 3 & " ~ Is too big, it has
been split in sections!")
End With


End If



Next Item
End Sub

 

[Tom Ogilvy]

Hard to tell what you are doing, but maybe this will help. I would test it
on something much less than F4:J152
Sub checksize()
Range("f4:J152").Select
For Each Item In Selection
Do Until Item <= 40
With Item
Range("A" & Item.Row & ":" & "v" & Item.Row).Select
Item.Value = Item.Value - 35
Selection.Copy
Selection.Insert Shift:=xlDown
Item.Value = 35
MsgBox ("Item " & Item.Row - 3 & " ~ Is too big, it has been split in
sections!")
End With
Loop
Next Item
End Sub

 

[Kev]

thanks for the reply, it didn't work but it put me on the right path,
the following seems to do what i need but I will have to run a modifed
code for each column, instead of using one code for a range of columns

thanks kev


Sub checksize()
'checks the range for values over 40
Range("f4:f10").Select
For Each Item In Selection
Dim wesname
wesname = Item.Offset(0, Item.Column - 10).Value
'spilts the data until all sections are below 40
With Item
intcounter = Item
copycounter = 1
Itemnum = Item.row - 4
Do Until intcounter <= 41
ranger = Item.row
rangerclmn = Item.Column


Range("b" & ranger & ":" & "v" & ranger).Select
Item.Value = 40
Selection.Copy
Selection.Insert Shift:=xlDown

Range(rangerclmn & ":" & ranger).Select
Item.Value = intcounter - 40
intcounter = intcounter - 40
'copies the description and adds cont'd + number for each time the item
is split
Item.Offset(0, Item.Column - 10).Value = wesname & " ~
Cont'd (" & copycounter & ")"
copycounter = copycounter + 1
Loop

End With

Next Item
End Sub