On Jun 24, 4:39*pm, u473 wrote:
From one period to the next, some new codes charges will be active
and some previously active codes will not.
I need to merge and sort the current period with the previous period
data,
calculate the gain and trend from the previous period.
My problem in the code below, is after the merging, for the final
sorting,
if one period row of data needs to be shifted, either range "A:C" or
range "D:F"
I do not know how to address the range.
..................................
Period 1
Code *%Val *%Prog
B1 * * * *50 * * * 55
D2 * * * *60 * * * 54
E1 * * * *72 * * * 72
G3 * * * *70 * * * 62
............................
Period 2
Code *%Val *%Prog
A1 * * * *15 * * * 10
B1 * * * *56 * * * 64
D2 * * * *68 * * * 60
F3 * * * *84 * * * 86
G3
.............................
E1 was not active in Period 2, but new codes A1 & F3 did.
Desired result after Merge & Sort :
A * * * * *B * * * *C * * * * *D * * * E * * * * F
G * * * * * *H * * * * * * * * I
Code *%Val *%Prog *Code *%Val *%Prog ValGain *ProgGain PeriodTrend
* * * * * * * * * * * * * * * * * A1 * * *15
10
B1 * * * *50 * * * 55 * * * *B1 * * *56 * * * 64
6 * * * * * *9 * * * * * * * * 1.5
D2 * * * *60 * * * 54 * * * *D2 * * *68 * * * 60
8 * * * * * *6 * * * * * * * * *.75
E1 * * * *72 * * * 72
* * * * * * * * * * * * * * * * * F3 * * *87 * * * 89
G3 * * * *70 * * * 62 * * * G3 * * *75 * * * 67 * * * * * *5
5 * * * * * * * * 1.0
..................................................
Sub SortandAlign2Ranges()
*Application.ScreenUpdating = False
* * Workbooks.Add
* * ActiveWorkbook.SaveAs "c:\bookc.xls"
* * Workbooks.Open "c:\booka.xls"
* * Workbooks("booka.xls").Worksheets(1).Range("A:C"). Copy
* * Workbooks("bookc.xls").Activate
* * Sheets(1).Cells(1, 1).Select
* * Workbooks("bookc.xls").Sheets(1).Paste
* * Application.CutCopyMode = False
* * Application.DisplayAlerts = False
* * Workbooks("booka.xls").Close
* * Application.DisplayAlerts = True
* * Workbooks.Open "c:\bookb.xls"
* * Workbooks("bookb.xls").Worksheets(1).Range("A:C"). Copy
* * Workbooks("bookc.xls").Activate
* * Sheets(1).Cells(1, 4).Select
* * Workbooks("bookc.xls").Sheets(1).Paste
* * Application.CutCopyMode = False
* * Application.DisplayAlerts = False
* * Workbooks("bookb.xls").Close
* * Application.DisplayAlerts = True
* * CompareAndShift "A:C", "D:F"
* * Application.ScreenUpdating = True
End Sub
.................................................. ........... Note :
Above code works fine
Sub CompareAndShift(LRange As String, Rrange As String)
Dim aRow As Integer, bRow As Integer
Dim ShortCol As String
Dim LastRowL As Integer, LastRowR As Integer
Dim LCol As String, RCol As String
LCol = Left(LRange, 1)
RCol = Left(Rrange, 1)
Columns(LRange).Sort Key1:=Range(LCol & 1), Order1:=xlAscending
Columns(Rrange).Sort Key1:=Range(RCol & 1), Order1:=xlAscending
LastRowL = Cells(Rows.Count, LCol).End(xlUp).Row
LastRowR = Cells(Rows.Count, RCol).End(xlUp).Row
If LastRowL LastRowR Then
* * bRow = LastRowL
* * ShortCol = RCol
Else
* * bRow = LastRowR
* * ShortCol = LCol
End If
'================================= Note : Above sorting code works
fine
For aRow = bRow To 1 Step -1
* * If Cells(aRow, LCol) = Cells(bRow, RCol) Or Cells(bRow, ShortCol)
= "" Then
* * * * 'do nothing
* * ElseIf Cells(aRow, LCol) < Cells(bRow, RCol) Then
* * * * ShiftIt bRow, RCol, aRow, LCol
'=====Problem starts here. *In the above line, how do I instruct the
current row
' * * * * * * * * * * * * * * to be shifted for range "D:F"
' * * * * * * * * * * * * * * Same logic after the Else below, for
range "A:C"
* *Else
* * * * ShiftIt aRow, LCol, bRow, RCol
* *End If
* * bRow = bRow - 1
* *'Calculate Gain & Trend
* *If Cells(aRow, LCol) = Cells(bRow, RCol)
* * * 'Store Value Gain * * *: *"E" Col value - "B" Col value * * *in
"G" Col
* * * 'Store Progtress Gain : *"F" Col value - "C" Col value * * in
"H" Col
* * * 'Store Trend * * * * * * * : *("H" Col value / *"G" Col value)
in "I" Col
* *End If
Next aRow
End Sub
.................................................
Sub ShiftIt(PrimaryShift As Integer, PSCol As String, SecondaryShift
As Integer, SSCol As String)
* * Cells(PrimaryShift, PSCol).Insert shift:=xlDown
* * If Cells(SecondaryShift + 1, SSCol) < Cells(PrimaryShift + 1,
PSCol) Then
* * * * Cells(SecondaryShift + 1, SSCol).Insert shift:=xlDown
* * Else
* * * * Cells(PrimaryShift + 2, PSCol).Delete shift:=xlUp
* * End If
End Sub

"If desired, send your fileS to dguillett @gmail.com I will only
look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results."