View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Bill Renaud[_2_] Bill Renaud[_2_] is offline
external usenet poster
 
Posts: 117
Default Copy Paired Info into Diff # of rows

Minor correction to the VBA code solution: When setting a cell to a new
value, use the Formula property instead of the Value property to insure
correct operation, for backward compatibility with older versions of Excel.
In older versions of Excel, setting the Value property did NOT change the
formula. The next time the workbook was recalculated, the value set by the
VBA code was overwritten. So the code inside the With statement should
technically be written as follows:

With ws
.Range(.Cells(rngStart.Row, 1), .Cells(rngEnd.Row, 1)).Formula = _
.Cells(rngStart.Row, 3).Value
.Range(.Cells(rngStart.Row, 2), .Cells(rngEnd.Row, 2)).Formula = _
.Cells(rngStart.Row, 4).Value
End With
--
Regards,
Bill


"Bill Renaud" wrote in message
...
As it turns out, there are 2 ways to solve this problem:
1. Use a spreadsheet formula.
2. Use a VBA macro.

================================================== =======
1. The spreadsheet formula method checks the row above each County Name to
see
if it is either blank or the value "County Non-Migrants". If it is, then
copy the value of column C:D on the row to column A:B of the same row,
otherwise copy the value from the row above. Follow these steps:

1. Enter the following formula into cells $A$5:$B$17 (where each County

Name
is listed in column $E):
=IF(OR(ISBLANK($E4),$E4="County Non-Migrants"),C5,A4)
2. Then Copy and Paste|Special Values to put the value back into these

cells
and remove the formulas.

================================================== =======
2. The VBA macro method:

Public Sub CopyCDtoAB()
Dim ws As Worksheet
Dim rngStart As Range 'Starting County Name.
Dim rngEnd As Range 'End of data section at "County Non-Migrants".

Set ws = ActiveSheet
Set rngStart = ws.Cells(1, 5).End(xlDown)

Do
Set rngEnd = ws.Cells.Find(What:="County Non-Migrants", _
After:=rngStart, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If (rngEnd Is Nothing) Then Exit Do
If (rngEnd.Row < rngStart.Row) Then Exit Do

'End of this section of data has been found.
'Copy values to columns $A and $B.
With ws
.Range(.Cells(rngStart.Row, 1), .Cells(rngEnd.Row, 1)).Value = _
.Cells(rngStart.Row, 3).Value
.Range(.Cells(rngStart.Row, 2), .Cells(rngEnd.Row, 2)).Value = _
.Cells(rngStart.Row, 4).Value
End With
Set rngStart = rngEnd.Offset(1, 0)
Loop
End Sub

--
Regards,
Bill