VBA Code Not Working When Matching Date

O

OilEconomist

Active Member
Joined
Dec 26, 2016
Messages
421
Office Version
  1. 2019
Platform
  1. 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:
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
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Sort by date Sort by votes
You have trouble finding the date on the following line:

Code: 
[COLOR=#333333]Set VR = Sheets("CF.by.Category").Range("B1:WD1").Find(DT, LookIn:=xlValues, LookAt:=xlWhole)[/COLOR]


The cell Sheets("Output").Cells(5, 1) and the row Sheets("CF.by.Category").Range("B1:WD1") must have the same date format "dd / mm / yyyy "
Try and tell me

Code: 
'Obtains the starting date of the Output
                DT = Sheets("Output").Cells(5, 1).Value
 
Upvote 0
You must log in or register to reply here.

Similar threads

P
  • Solved
Counter in For Each loop
Replies
2
Views
196
Possum17
P
J
  • Question
VBA to select partial filename and go back and forth between two files to copy paste
Replies
1
Views
166
shknbk2
S
B
  • Solved
vba code to give next Sunday date for pasted data
Replies
2
Views
185
bh24524
B
H
  • Question
VBA Speed up Copy and paste
Replies
3
Views
370
skillilea
S
excelbytes
  • Solved
Subscript Out Of Range Error 9
Replies
2
Views
443
excelbytes
excelbytes

Forum statistics

Threads
1,214,943
Messages
6,122,376
Members
449,080
Latest member
Armadillos

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top