OilEconomist
Active Member
- Joined
- Dec 26, 2016
- Messages
- 439
- Office Version
- 2019
- Platform
- Windows
Thanks in advance for any suggestions for which I will give feedback.
Anybody know why it's ignoring my data or what part of my code is incorrect?
The following code causes the remainder of the code not to execute after it finds Category A. Once it finds the first category that exists, whether it be A, B, C, etc., it will not execute anything after it. Basically if A exists, it will copy and paste into the sheet "CF.by.Category" and any subsequent categories that exist, it will ignore. When I remove it, the remainder of the code works fine.
Code causing the issue:
The following is the entire code
Anybody know why it's ignoring my data or what part of my code is incorrect?
The following code causes the remainder of the code not to execute after it finds Category A. Once it finds the first category that exists, whether it be A, B, C, etc., it will not execute anything after it. Basically if A exists, it will copy and paste into the sheet "CF.by.Category" and any subsequent categories that exist, it will ignore. When I remove it, the remainder of the code works fine.
Code causing the issue:
Code:
'Find the column (month and year) where the data starts. The raw output doesn't always start in the first _
month of the year
'Copies the format of the date
Sheets("Output").Range("A5").Copy
'Activates the "CF.by.Category" tab to temporarily change the date format
Worksheets("CF.by.Category").Activate
'Changes the date format in the "CF.by.Category" tab
Worksheets("CF.by.Category").Range("B1:WD1").PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Obtains the starting date of the Output
DT = Sheets("Output").Cells(5, 1).Value
'Activates the "CF.by.Category" tab
Worksheets("CF.by.Category").Activate
'Gets the position of the starting date on the "Total" tab
Set VR = Sheets("CF.by.Category").Range("B1:WD1").Find(DT, LookIn:=xlValues, LookAt:=xlWhole)
If Not VR Is Nothing Then
ClmSDNumber = VR.Column
Else
End If
'Convert To Column Letter
ClmSDLetter = Split(Cells(1, ClmSDNumber).Address, "$")(1)
'Changes the date format back to the original format
Worksheets("CF.by.Category").Range("B1:WD1").NumberFormat = "yyyy-mm"
The following is the entire code
Code:
Sub TransposeDataX()
'Dimensioning
Dim i As Long
Dim j As Long
Dim LastRow As Long 'This will be the Last Row of all the Output
Dim StartRow As Long 'This will be where each section of the Data Starts within Output
Dim LRP As Long 'This is the Last Row of the Total and each Category Data within the Output Tab
Dim Category As String
'These are all to find the position of the matching dates
Dim DT As Date
Dim VR As Range
Dim ClmSDNumber As Long 'This is for the column start date which will be represented as a number
Dim ClmSDLetter As String 'This is for the column start date which will be represented as a letter
'Turns off screen alerts and automatic calculating
'Turn off Display Alerts
Application.DisplayAlerts = False
'Turn Off Screen Updating
Application.ScreenUpdating = False
'Turn off Automatic Calculation & Calculate
Application.Calculation = xlManual
Calculate
'Deletes the "CF.by.Category" tab if it exists and then creates a blank one by copying the template _
Template. CF.by.Category
'Checks if the "CF.by.Category" tab exists and if it does, it deletes it.
For Each Sheet In ActiveWorkbook.Worksheets
If Sheet.Name = "CF.by.Category" Then
Sheet.Delete
End If
Next Sheet
'Copies the "Template.CF.by.Category" after "Start.Cash.Flow.by.RC"
Sheets("Template.CF.by.Category").Copy after:=Sheets("Start.Cash.Flow.by.RC")
ActiveSheet.Name = "CF.by.Category"
'Expands the CF Tab
Worksheets("CF.by.Category").Activate
ActiveSheet.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8
'Activate the "Output" Tab
Sheets("Output").Activate
'The Total for all Categories will always be the first data set. The Categories will beneath it
Cells(1, 12).Value = "Grand Total"
'Find the column (month and year) where the data starts. The raw output doesn't always start in the first _
month of the year
'Copies the format of the date
Sheets("Output").Range("A5").Copy
'Activates the "CF.by.Category" tab to temporarily change the date format
Worksheets("CF.by.Category").Activate
'Changes the date format in the "CF.by.Category" tab
Worksheets("CF.by.Category").Range("B1:WD1").PasteSpecial Paste:=xlPasteFormats, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Obtains the starting date of the Output
DT = Sheets("Output").Cells(5, 1).Value
'Activates the "CF.by.Category" tab
Worksheets("CF.by.Category").Activate
'Gets the position of the starting date on the "Total" tab
Set VR = Sheets("CF.by.Category").Range("B1:WD1").Find(DT, LookIn:=xlValues, LookAt:=xlWhole)
If Not VR Is Nothing Then
ClmSDNumber = VR.Column
Else
End If
'Convert To Column Letter
ClmSDLetter = Split(Cells(1, ClmSDNumber).Address, "$")(1)
'Changes the date format back to the original format
Worksheets("CF.by.Category").Range("B1:WD1").NumberFormat = "yyyy-mm"
'Find the Last Row of all the data
LastRow = Cells.Find(What:="*", after:=Range("A1"), LookAt:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
'Loops through column L first and then column M
'Loop through the data and find the different Categories to Paste
For i = 1 To LastRow
Sheets("Output").Activate
If Cells(i, 13).Value = "Grand Total" Then
RowPasteCF = 4
StartRow = i + 4
ElseIf Cells(i, 13).Value = "Category A" Then
RowPasteCF = 44
StartRow = i + 4
ElseIf Cells(i, 13).Value = "Category B" Then
RowPasteCF = 84
StartRow = i + 4
ElseIf Cells(i, 13).Value = "Category C" Then
RowPasteCF = 164
StartRow = i + 4
ElseIf Cells(i, 13).Value = "Category D" Then _
RowPasteCF = 244
StartRow = i + 4
ElseIf Cells(i, 13).Value = "Category E" Then
RowPasteCF = 324
StartRow = i + 4
ElseIf Cells(i, 13).Value = "Category F" Then
RowPasteCF = 404
StartRow = i + 4
End If
If Category = "Grand Total" _
Or Category = "Category A" _
Or Category = "Category B" _
Or Category = "Category C" _
Or Category = "Category D" _
Or Category = "Category E" _
Or Category = "Category F" _
Then
'Copying and Pasting The Data
'Find the last row (LRP)
LRP = Range("A" & StartRow).End(xlDown).Offset(1).Row
LRP = LRP - 2
'Section 1
'Copying
With Sheets("Output")
.Range(.Cells(StartRow, 2), .Cells(LRP, 4)).Copy
End With
'Pasting
Sheets("CF.by.Category").Select
Worksheets("CF.by.Category").Range(ClmSDLetter & RowPasteCF).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'Section 2
'Copying
With Sheets("Output")
.Range(.Cells(StartRow, 5), .Cells(LRP, 7)).Copy
End With
'Pasting
Sheets("CF.by.Category").Select
Worksheets("CF.by.Category").Range(ClmSDLetter & (RowPasteCF + 4)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'Section 3
'Copying
With Sheets("Output")
.Range(.Cells(StartRow, 8), .Cells(LRP, 10)).Copy
End With
'Pasting
Sheets("CF.by.Category").Select
Worksheets("CF.by.Category").Range(ClmSDLetter & (RowPasteCF + 8)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'Section 4
'Copying
With Sheets("Output")
.Range(.Cells(StartRow, 11), .Cells(LRP, 12)).Copy
End With
'Pasting
Sheets("CF.by.Category").Select
Worksheets("CF.by.Category").Range(ClmSDLetter & (RowPasteCF + 12)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'Section 5
'Copying
With Sheets("Output")
.Range(.Cells(StartRow, 13), .Cells(LRP, 14)).Copy
End With
'Pasting
Sheets("CF.by.Category").Select
Worksheets("CF.by.Category").Range(ClmSDLetter & (RowPasteCF + 17)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
'Section 6
'Copying
With Sheets("Output")
.Range(.Cells(StartRow, 15), .Cells(LRP, 15)).Copy
End With
'Pasting
Sheets("CF.by.Category").Select
Worksheets("CF.by.Category").Range(ClmSDLetter & (RowPasteCF + 32)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End If
Next i
'Ending the Loop
'Sets the cursor at the begining
Worksheets("CF.by.Category").Activate
Range("B4").Select
'Turn On Screen Updating
Application.ScreenUpdating = True
'Calculate and Turn on Automatic Calculation
Calculate
Application.Calculation = xlAutomatic
End Sub