Reduce a value by spliting the data

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

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

--
Regards,
Tom Ogilvy


"Kev" <[email protected]> wrote in message
news:[email protected]...
> 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

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



Tom Ogilvy wrote:
> 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
>