Dynamic copying & pasting of rows

Hi All,

I have a large number of Excel files in several folders that I need to
perform the following task in. I know how to write VBA code to move from file
to file in order to apply the task, but I can’t figure out how to write a
program to do the task itself.

Each file contains three columns of coordinates (in columns A, B & C) , with
the headings X, Y & Z in row 1 of the three columns. The first few rows all
contain the number 5 in column B. I need to copy all of these rows and then
paste them starting in row 2 without overwriting any of the data in the
original rows, i.e. I need to insert a number of empty rows equal to the
number of copied rows starting in row 2. Finally, I need to change all the
fives in the PASTED data to zeros.

The problem is that the number of rows with 5 in column B varies from file
to file, and I can’t figure out a way to deal with this variation in my code.

Any help would be greatly appreciated!

Many thanks,

Chris Bromley

Hi Chris,
The sub ProcessA. In the last lines it changes the 5 values in the source
to 0. Not sure if you wanted it to be done in the Source or the newly
inserted rows.

Sub test()
'search 5 in col B of Active sheet and insert into row 2 of worksheets(2)
processA activesheet, worksheets(2), 5
End Sub

'ProcessA :
' Searches value ValueToFind in source worksheet WshS, insert these rows
' (rgResult) in destination sheet WshD row 2. Finally set source to zero
Sub ProcessA(WshS As Worksheet, WshD As Worksheet, ValueToFind As Variant)
Dim rgS As Range, RgD As Range 'range source and destination
Dim found As Boolean, firstAddress As String
Dim rg As Range, rgResult As Range
Dim ttlRows As Long, i As Long

Set rgS = Application.Intersect(WshS.Columns(2), WshS.UsedRange)
Set RgD = WshD.Rows(2)

'Find all cells containing ValueToFind
Set rg = rgS.Find(ValueToFind, , xlValues, xlWhole)
If Not rg Is Nothing Then
firstAddress = rg.Address
Set rgResult = rg
Do
Set rgResult = Application.Union(rgResult, rg)
Set rg = rgS.FindNext(rg)
Loop While Not rg Is Nothing And rg.Address <> firstAddress
End If

'Insert into rgD and reset ValuesToFind in RgResult
If Not rgResult Is Nothing Then
RgD.Resize(rgResult.Cells.Count).Insert
rgResult.EntireRow.Copy WshD.Rows(2)
'Which one set to zero? in the source
rgResult.Value = 0
End If

End Sub
'---------------------------------------------

Regard,
Sebastien

"Chris Bromley" wrote:

> Hi All,
>
> I have a large number of Excel files in several folders that I need to
> perform the following task in. I know how to write VBA code to move from file
> to file in order to apply the task, but I can’t figure out how to write a
> program to do the task itself.
>
> Each file contains three columns of coordinates (in columns A, B & C) , with
> the headings X, Y & Z in row 1 of the three columns. The first few rows all
> contain the number 5 in column B. I need to copy all of these rows and then
> paste them starting in row 2 without overwriting any of the data in the
> original rows, i.e. I need to insert a number of empty rows equal to the
> number of copied rows starting in row 2. Finally, I need to change all the
> fives in the PASTED data to zeros.
>
> The problem is that the number of rows with 5 in column B varies from file
> to file, and I can’t figure out a way to deal with this variation in my code.
>
> Any help would be greatly appreciated!
>
> Many thanks,
>
> Chris Bromley
>

Thanks very much for replying and submitting this code Sebastien!
Unfortunately, though, I can't seem to get it to work. When I run the macro
no error messages appear, but also nothing appears to have happened to the
file on which I am testing it. Does this mean that it is perhaps copying the
data and pasting it back onto itself? Also, the 5s in column B are not being
replaced by zeros. Any ideas?

Regards,

Chris.

"sebastienm" wrote:

> Hi Chris,
> The sub ProcessA. In the last lines it changes the 5 values in the source
> to 0. Not sure if you wanted it to be done in the Source or the newly
> inserted rows.
>
> Sub test()
> 'search 5 in col B of Active sheet and insert into row 2 of worksheets(2)
> processA activesheet, worksheets(2), 5
> End Sub
>
> 'ProcessA :
> ' Searches value ValueToFind in source worksheet WshS, insert these rows
> ' (rgResult) in destination sheet WshD row 2. Finally set source to zero
> Sub ProcessA(WshS As Worksheet, WshD As Worksheet, ValueToFind As Variant)
> Dim rgS As Range, RgD As Range 'range source and destination
> Dim found As Boolean, firstAddress As String
> Dim rg As Range, rgResult As Range
> Dim ttlRows As Long, i As Long
>
> Set rgS = Application.Intersect(WshS.Columns(2), WshS.UsedRange)
> Set RgD = WshD.Rows(2)
>
> 'Find all cells containing ValueToFind
> Set rg = rgS.Find(ValueToFind, , xlValues, xlWhole)
> If Not rg Is Nothing Then
> firstAddress = rg.Address
> Set rgResult = rg
> Do
> Set rgResult = Application.Union(rgResult, rg)
> Set rg = rgS.FindNext(rg)
> Loop While Not rg Is Nothing And rg.Address <> firstAddress
> End If
>
> 'Insert into rgD and reset ValuesToFind in RgResult
> If Not rgResult Is Nothing Then
> RgD.Resize(rgResult.Cells.Count).Insert
> rgResult.EntireRow.Copy WshD.Rows(2)
> 'Which one set to zero? in the source
> rgResult.Value = 0
> End If
>
> End Sub
> '---------------------------------------------
>
> Regard,
> Sebastien
>
> "Chris Bromley" wrote:
>
> > Hi All,
> >
> > I have a large number of Excel files in several folders that I need to
> > perform the following task in. I know how to write VBA code to move from file
> > to file in order to apply the task, but I can’t figure out how to write a
> > program to do the task itself.
> >
> > Each file contains three columns of coordinates (in columns A, B & C) , with
> > the headings X, Y & Z in row 1 of the three columns. The first few rows all
> > contain the number 5 in column B. I need to copy all of these rows and then
> > paste them starting in row 2 without overwriting any of the data in the
> > original rows, i.e. I need to insert a number of empty rows equal to the
> > number of copied rows starting in row 2. Finally, I need to change all the
> > fives in the PASTED data to zeros.
> >
> > The problem is that the number of rows with 5 in column B varies from file
> > to file, and I can’t figure out a way to deal with this variation in my code.
> >
> > Any help would be greatly appreciated!
> >
> > Many thanks,
> >
> > Chris Bromley
> >

If the rows containing 5 will all be sequential, then this simpler Macro should do the trick:


Sub temp()
xrt = Application.CountIf(Columns((2), 5)
Range(Rows(2), Rows(xrt + 1)).Copy
Rows(2).insert
Range(Cells(2, 2), Cells(xrt + 1, 2)) = 0
End Sub

Use the following to prevent errors if there are no 5's in col B:

Sub temp()
xrt = Application.CountIf(Columns((2), 5)
If xrt > 0 Then
_ Range(Rows(2), Rows(xrt + 1)).Copy
_ Rows(2).insert
_ Range(Cells(2, 2), Cells(xrt + 1, 2)) = 0
_ Application.CutCopyMode = False
End If
End Sub

1. As a first line of the sub ProcessA add,
Msgbox WshS.Name & " - " & WshD.Name & " - " & ValueToFind
To check what is being passed as parameter when you run it.
2. Replace the last End If (right before the end of the sub End Sub) by:
Else
msgbox "No cell found with" & ValueToFind
Endif
3. For one of the cells containing a 5, say B10, in the immediate window,
enter:
?Range("B10")
to chcek its value and make sure it is not in fact like 5.00000012

Sebastien

Hi Sebastien,

This has helped tremendously! The value in the spreadsheet is actually
entered as 5.0, not 5, hence why the macro wasn't seeing the value. My fault
for this inaccuracy. Sorry! I've changed the argument accordingly in the Test
procedure and the relevant rows are now being copied and pasted as they
should be.

The only other thing is that I need to change the 5.0s to zeroes in the
newly pasted rows, not the source rows. I've tried playing around with this
line in the code but haven't been able to figure it out.

Chris.

"sebastienm" wrote:

> 1. As a first line of the sub ProcessA add,
> Msgbox WshS.Name & " - " & WshD.Name & " - " & ValueToFind
> To check what is being passed as parameter when you run it.
> 2. Replace the last End If (right before the end of the sub End Sub) by:
> Else
> msgbox "No cell found with" & ValueToFind
> Endif
> 3. For one of the cells containing a 5, say B10, in the immediate window,
> enter:
> ?Range("B10")
> to chcek its value and make sure it is not in fact like 5.00000012
>
> Sebastien

Chris,
1. Reset destination values to zero
What about replacing
rgResult.Value = 0
By
WshD.Rows(2).Resize(rgResult.Cells.Count).columns(2).value=0
2. Concerning the search of 5 vs 5.0
ValueToFind is a variant so that you can search for any data type. so:

Maybe replacing
processA activesheet, worksheets(2), 5
by
processA activesheet, worksheets(2), cstr(5)
to search the string "5"... Excel may search the displayed string
instead. I haven't tried it though.

I hope this helps,
Sebastienm