VBA Coding Help - Pulling Exact Data

Glasgowsmile

Active Member
Joined
Apr 14, 2018
Messages
280
Office Version
  1. 365
Platform
  1. Windows
Good Morning,

I've got coding for a report that works well, minus 1 small issue I'd like to correct.

Currently this code pulls data from another worksheet, pastes it into the active sheet and compares it to another hidden sheet with old data.

Instead of just copying data blindly, I need it to look at the Month on the hidden page and pull that data from the separate spreadsheet instead of just pulling whatever is in the cell range that I currently have listed.

For example: When I move from August to September, the new report I'm pulling from will have September data and the old report will show August data so when they pull and compare, they're comparing two separate months.

I need the report to ignore the august data and look for the September data and pull that instead.

Code:
Sub FuturePDI()    Dim wsPropertySegmentData As Worksheet
    Dim wkbSourceBook As Workbook
    Dim PasteCopyRange As Range, Area As Range
    Dim FileName As String
    
    Set wsPropertySegmentData = ThisWorkbook.Worksheets("Property Segment Data")
    
    Set PasteCopyRange = wsPropertySegmentData.Range("B2:I18,N4:AC18,B21:I34,N21:AC34,B37:I50,N37:AC50")
    
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel 2007-13", "*.xlsx; *.xls; *.xlsm; *.xlsa"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        FileName = .SelectedItems(1)
    End With
    
    On Error GoTo myerror
    With Application
        .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlCalculationManual
    End With
    
    PasteCopyRange.Clear
    
    Set wkbSourceBook = Workbooks.Open(FileName, , True)
    
    For Each Area In PasteCopyRange.Areas
        wkbSourceBook.Sheets("Property Segment Data").Range(Area.Address).Copy
        With Area.Cells(1, 1)
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
        End With
'clear clipboard
        Application.CutCopyMode = False
    Next Area
            
        wkbSourceBook.Close False
            
            
        Columns("A").EntireColumn.Hidden = True
        Rows("1").EntireRow.Hidden = True
        Columns("B").ColumnWidth = 23
        Columns("C").ColumnWidth = 28
        Columns("N").ColumnWidth = 28
        Columns("D:L").ColumnWidth = 11
        Columns("O:AC").ColumnWidth = 11
            
myerror:
        With Application
            .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlCalculationAutomatic
        End With
        If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number

Forum statistics

Threads
1,223,893
Messages
6,175,246
Members
452,623
Latest member
cliftonhandyman

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