Solved: Copy & Paste and Adjust Data

[Pete]

See attached workbook.......Vol.xls

Hi

Need a macro to cut copy and past data from column B worksheet "Deal Selection" into highlighted section in worksheet "Volume"..... in grey

The tables in worksheet "Vol" column B need to adjust as the data in column B worksheet "Deal Selection" increase or decrease...

[Bob Phillips]

Public Sub ProcessData()
Dim i As Long
Dim LastRow As Long
Dim NumRows As Long
Dim SalesRow As Long
Dim TargetRows As Long
Dim cell As Range

With Application

' .ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With Worksheets("Deal Selection")

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
NumRows = LastRow - 8
End With

With Worksheets("Volume Summary")

Set cell = .Columns(2).Find("Sale Contracts")
If Not cell Is Nothing Then

SalesRow = cell.Row
TargetRows = SalesRow - 9 - 2
If TargetRows < NumRows Then

.Rows(10).Resize(NumRows - TargetRows).Insert
ElseIf TargetRows > NumRows Then

.Rows(10).Resize(TargetRows - NumRows).Delete
End If

Worksheets("Deal Selection").Cells(9, "B").Resize(NumRows).Copy .Range("B9")
With .Range("B9").Resize(NumRows).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
End With


With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

[Pete]

thanks for the excellent feed back...... i am guessing i can change column B to I to repeart the procees for the other column...

[Bob Phillips]

Yes, b ut if you are doing that two things to consider.

Firstly, is each block the same size. The code actively uses the size. Then, you should look to put the repeated code into a sub procedure, to cut dow the code and make it easier to maintain.

[Pete]

Xld....if i was to also insert the same data into column b Worksheet "Volume Summary" re: Highlighted sectionsin yellow.......how would this be done...

see new work book attached

[Bob Phillips]

Public Sub Process_Supply()
Dim i As Long
Dim LastRow As Long
Dim Numrows As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With Worksheets("Deal Selection")

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Numrows = LastRow - 8
End With

Call CopyData("Obligations", Numrows)
Call CopyData("Actual Allocations", Numrows)

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

Private Sub CopyData(ByVal Section As String, ByVal Numrows As Long)
Dim SalesRow As Long
Dim TargetRows As Long
Dim BaseCell As Range
Dim cell As Range

With Worksheets("Volume Summary")

Set cell = .Columns(2).Find(Section)
If Not cell Is Nothing Then

Set BaseCell = cell.Offset(5, 0)
Set cell = .Columns(2).Find(What:="Sale Contracts", after:=cell)
If Not cell Is Nothing Then

SalesRow = cell.Row
TargetRows = SalesRow - BaseCell.Row - 2
If TargetRows < Numrows Then

.Rows(BaseCell.Row + 1).Resize(Numrows - TargetRows).Insert
ElseIf TargetRows > Numrows Then

.Rows(BaseCell.Row + 1).Resize(TargetRows - Numrows).Delete
End If

Worksheets("Deal Selection").Cells(9, "B").Resize(Numrows).Copy BaseCell
With BaseCell.Resize(Numrows).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
End If
End With

End Sub

[Pete]

Thank you work like a dream.......thank you once again for the feedback.