amrita17170909
Board Regular
- Joined
- Dec 11, 2019
- Messages
- 74
- Office Version
- 2019
- 2016
- 2013
- Platform
- Windows
Hi All,
I am generating a report which looks like below at the moment :
I am using the below program to generate it:
I would like an additional step :
1. Checks the values in column AE for all rows having the same ID in column A
2. The rows from D to AE will be in ascending order.
so e.g if values in column AE are as per below
-1
-2
5
6
3
Then the program is going to make all rows as per ascending order :
-2
-1
3
5
6
I hope this makes sense.
Amrita
I am generating a report which looks like below at the moment :
I am using the below program to generate it:
VBA Code:
Sub generate_report_v_4_test() ' step 7
Dim LastRow As Long, ctr As Long, fSumRow As Long, lSumRow As Long
Dim SwapAry As Variant
Dim SwapAry1 As Variant
Dim cCel As Range
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
If SheetExists("Attachment A") Then
Sheets("Attachment A").Delete
End If
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Attachment A"
With Sheets("Table 4")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A2:AB" & LastRow).copy _
Destination:=Sheets("Attachment A").Range("A6")
End With
'To delete Grand Total
With Sheets("Attachment A")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If .Range("A" & LastRow) = "Grand Total" Then .Rows(LastRow).Delete
End With
With Sheets("Attachment A")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Columns("C").EntireColumn.Insert _
Shift:=xlShiftToRight
.Range("G" & LastRow).Offset(1).Value = UCase("total")
' This loop finds all the BRN and adds a blank between other BRN
For ctr = LastRow To 5 Step -1
If .Range("A" & ctr).Value <> .Range("A" & ctr).Offset(-1).Value Then
If .Range("A" & ctr).Offset(-1).Value <> "" Then
' blank condition if offset -1 is blank non numeric then go to end if
.Range(ctr & ":" & ctr + 1).EntireRow.Insert _
Shift:=xlShiftDown
.Range("G" & ctr).Value = UCase("total")
' Else Goto Next ctr
End If
End If
Next ctr
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
' MsgBox (LastRow)
fSumRow = 6
While lSumRow < LastRow
lSumRow = .Range("A" & fSumRow).End(xlDown).Row
' MsgBox (lSumRow)
.Range("H" & lSumRow + 1 & ":AE" & lSumRow + 1).Formula = "=SUM(H" & fSumRow & ":H" & lSumRow & ")"
.Range("G" & lSumRow + 1 & ":AE" & lSumRow + 1).Interior.Color = RGB(240, 240, 240)
.Range("G" & lSumRow + 1 & ":AE" & lSumRow + 1).Borders.LineStyle = xlContinuous
.Range("G" & lSumRow + 1 & ":AE" & lSumRow + 1).HorizontalAlignment = xlCenter
.Range("G" & lSumRow + 1 & ":AE" & lSumRow + 1).WrapText = True
For ctr = fSumRow To lSumRow
.Range("AD" & ctr).Formula = "=SUM($H" & ctr & ":$AB" & ctr & ")"
.Range("AE" & ctr).Formula = "=SUM($H" & ctr & ":$AC" & ctr & ")"
' If .Range("AE" & ctr).Value > Range("A" & ctr).Offset(-1).Value Then
'SwapAry=
Next ctr
fSumRow = lSumRow + 3 'condition to bring out of the loop
' MsgBox (fSumRow)
Wend
End With
Call report_aesthetics_1_test
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End SubI would like an additional step :
1. Checks the values in column AE for all rows having the same ID in column A
2. The rows from D to AE will be in ascending order.
so e.g if values in column AE are as per below
-1
-2
5
6
3
Then the program is going to make all rows as per ascending order :
-2
-1
3
5
6
I hope this makes sense.
Amrita
