Replicating rows and putting in data based on criteria

[baggarwal]

Hi All:

Here is the file I need your help on:

Book2
	A	B	C	D	E	F
2	Current
3	700027	5133000	COS:contractclean			270
4						1,510
5
6	700028	5133000	COS:contractclean			540
7						0
8
9	700356	5133000	COS:contractclean			2,050
10						417
11	Desired
12	700027	5133000	COS:contractclean		Budget	270
13	700027	5133000	COS:contractclean		Actual	1,510
14
15	700028	5133000	COS:contractclean		Budget	540
16	700028	5133000	COS:contractclean		Actual	0
17
18	700356	5133000	COS:contractclean		Budget	2,050
19	700356	5133000	COS:contractclean		Actual	417
Sheet1

I have setup the spreadsheet so that the current section contains the a block of data I need a macro to convert into the desired outcome.

Can you please help me build a macro that will do the following for me:

1. In the current section, if A3 contains an order number (i.e. 700027). I need A3:C3 to be replicated in A4:C4. But I need the macro to do this wherever an internal order number is found. So A6 contains an order number so replicate A6:C6 in A7:C7.

2. Now the next thing I need the macro to do is put in the word "Budget" in cell D12 and the word "actual" in cell D13 if the an internal order number is located in cell A12. I also need the macro to repeat the process in the same way if an order number is found in column.

Thanks so much in advance for your help on this,

Bharat

 

[Tom Urtis]

Here is one way to do that, and there are probably other (more efficient) ways.

Your screen shot shows Budget and Actual in column E but your text says it should go in column D. The following code will put those words in column E to coincide with your screen shot.

The following macro assumes that, according to your example, in column A there is an order number or nothing at all. Therefore, the code searches for anything and does the text changes you indicated.

This worked when I tested it:

Sub CurrentToDesired()
Application.ScreenUpdating = False
Dim NumCol As Range, cell As Range, rToChange As Range
Set NumCol = Range([A3], [A65536].End(xlUp))
For Each cell In NumCol
If cell.Value <> "" Then
If rToChange Is Nothing Then
Set rToChange = cell
Else
Set rToChange = Application.Union(rToChange, cell)
End If
End If
Next
With rToChange
.Offset(1, 0).Value = .Value
.Offset(1, 1).Value = .Offset(0, 1).Value
.Offset(1, 2).Value = .Offset(0, 2).Value
.Offset(0, 4).Value = "Budget"
.Offset(1, 4).Value = "Actual"
End With
Application.ScreenUpdating = True
End Sub

 

[baggarwal]

Hi Tom:

It looks like the A3:B3 combination is being replicated all the way down. So this means that A7 = A3 and B7 =B3; I want to set up the macro so that A7 = A6 and B7 = B6; A10 = A9 and B10 =B9.

Can you help me fix this?

Bharat

 

[bolo]

Hi ihave just modified TU's code. Hope you don't mind!

Sub CurrentToDesired()
Application.ScreenUpdating = False
Dim NumCol As Range, cell As Range, rToChange As Range
Set NumCol = Range([A3], [A65536].End(xlUp))
For Each cell In NumCol
If cell.Value<> "" Then
If rToChange Is Nothing Then
With cell
.Offset(1, 0).Value = .Value
.Offset(1, 1).Value = .Offset(0, 1).Value
.Offset(1, 2).Value = .Offset(0, 2).Value
.Offset(0, 4).Value = "Budget"
.Offset(1, 4).Value = "Actual"
End With
Set rToChange = cell
ElseIf rToChange = cell Then
Set rToChange = Nothing
End If
End If
Next
Application.ScreenUpdating = True
End Sub

This should work. HTH

For me Toms 'Union' code bit wasn't working properly.
This message was edited by bolo on 2002-10-13 11:23

 

[baggarwal]

Tom, you are the magic man thankyou.

Bolo, thanks so much for your help too.

This issue has been resolved.

BA