amrita17170909
Board Regular
- Joined
- Dec 11, 2019
- Messages
- 74
- Office Version
- 2019
- 2016
- 2013
- Platform
- Windows
Hi All,
The below program is used to build a report and it works well except if it encounters a single line.
I am thinking of incorporating an If statement to counter that eventuality.
Can anyone help me as to what that If statement can look like?
The below program is used to build a report and it works well except if it encounters a single line.
I am thinking of incorporating an If statement to counter that eventuality.
VBA Code:
Sub generate_report_v_4_test() ' Generates Attachment A
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
Dim EndofBlock As Long
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("Attachment A Raw")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A2:AC" & LastRow).copy _
Destination:=Sheets("Attachment A").Range("A6")
End With
'To delete Grand Total line incase it comes through
With Sheets("Attachment A")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If .Range("A" & LastRow) = "Grand Total" Then
.Rows(LastRow).Delete
End If
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Columns("C").EntireColumn.Insert _
Shift:=xlShiftToRight
.Range("F" & LastRow).Offset(1).Value = UCase("total")
' code to populate the positives at the top and the negatives at the bottom
EndofBlock = LastRow
' 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
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range( _
"AD" & ctr & ":AD" & EndofBlock), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With .Sort
.SetRange Range("A" & ctr & ":AD" & EndofBlock)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
EndofBlock = ctr - 1
' blank condition if offset -1 is blank non numeric then go to end if
.Range(ctr & ":" & ctr + 1).EntireRow.Insert _
Shift:=xlShiftDown
.Range("F" & ctr).Value = UCase("total")
' Else Goto Next ctr
End If
End If
Next ctr
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range( _
"AD6:AD" & EndofBlock), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With .Sort
.SetRange Range("A6:AD" & EndofBlock)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'The below code add the line "Total" and does formatting
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
fSumRow = 6
While lSumRow < LastRow
lSumRow = .Range("A" & fSumRow).End(xlDown).Row
.Range("G" & lSumRow + 1 & ":AD" & lSumRow + 1).Formula = "=SUM(G" & fSumRow & ":G" & lSumRow & ")"
.Range("F" & lSumRow + 1 & ":AD" & lSumRow + 1).Interior.Color = RGB(240, 240, 240)
.Range("F" & lSumRow + 1 & ":AD" & lSumRow + 1).Borders.LineStyle = xlContinuous
.Range("F" & lSumRow + 1 & ":AD" & lSumRow + 1).HorizontalAlignment = xlCenter
.Range("F" & lSumRow + 1 & ":AD" & lSumRow + 1).WrapText = True
For ctr = fSumRow To lSumRow
.Range("AC" & ctr).Formula = "=SUM($G" & ctr & ":$AA" & ctr & ")"
.Range("AD" & ctr).Formula = "=SUM($G" & ctr & ":$AB" & ctr & ")"
Next ctr
fSumRow = lSumRow + 3 'condition to bring out of the loop
Wend
End With
'change -values to ()
End SubCan anyone help me as to what that If statement can look like?
