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 cant 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 cant 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 cant 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 cant 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 cant 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 cant figure out a way to deal with this variation in my code.

Any help would be greatly appreciated!

Many thanks,

Chris Bromley

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