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" wrote in message
. uk...
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