0

i have tried many sites and am really struggling as i cant seem to understand the VBA code

tab1 = data from C8:Rx? ... the data will continously grow so table will get bigger all the time

Column C in tab1 contains dates 21/05/2021

I want to be able to have 2 prompt boxes where i enter a date from and date to 21/05/2021 - 22/05/2021

when i action the macro it will take only the data from the table in tab1 in between these dates

and paste them in tab2 at cell ref c8 (the start of the table)

Option Explicit

'This subroutine prompts the user to select dates
Public Sub PromptUserForInputDates()
    
    Dim strStart As String, strEnd As String, strPromptMessage As String
    
    'Prompt the user to input the start date
    strStart = InputBox("Please enter the start date")
    
    'Validate the input string
    If Not IsDate(strStart) Then
        strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                           "date. Please retry with a valid date..."
        MsgBox strPromptMessage
        Exit Sub
    End If
    
    'Prompt the user to input the end date
    strEnd = InputBox("Please enter the end date")
    
    'Validate the input string
    If Not IsDate(strStart) Then
        strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                           "date. Please retry with a valid date..."
        MsgBox strPromptMessage
        Exit Sub
    End If
    
    'Call the next subroutine, which will do produce the output workbook
    Call CreateSubsetWorkbook(strStart, strEnd)
    
End Sub
'This subroutine creates the new workbook based on input from the prompts
Public Sub CreateSubsetWorkbook(StartDate As String, EndDate As String)
    
    Dim wbkOutput As Workbook
    Dim wksOutput As Worksheet, wks As Worksheet
    Dim lngLastRow As Long, lngLastCol As Long, lngDateCol As Long
    Dim rngFull As Range, rngResult As Range, rngTarget As Range
    
    'Set references up-front
    lngDateCol = 3 '<~ we know dates are in column C
    Set wbkOutput = Workbooks.Add
    
    'Loop through each worksheet
    For Each wks In ThisWorkbook.Worksheets
        With wks
        
            'Create a new worksheet in the output workbook
            Set wksOutput = wbkOutput.Sheets.Add
            wksOutput.Name = wks.Name
            
            'Create a destination range on the new worksheet that we
            'will copy our filtered data to
            Set rngTarget = wksOutput.Cells(1, 1)
        
            'Identify the data range on this sheet for the autofilter step
            'by finding the last row and the last column
            lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row
            lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).Column
            Set rngFull = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol))
            
            'Apply a filter to the full range to get only rows that
            'are in between the input dates
            With rngFull
                .AutoFilter Field:=lngDateCol, _
                            Criteria1:=">=" & StartDate, _
                            Criteria2:="<=" & EndDate
                
                'Copy only the visible cells and paste to the
                'new worksheet in our output workbook
                Set rngResult = rngFull.SpecialCells(xlCellTypeVisible)
                rngResult.copy Destination:=rngTarget
            End With
            
            'Clear the autofilter safely
            .AutoFilterMode = False
            If .FilterMode = True Then
                .ShowAllData
            End If
        End With
    Next wks
    
    'Let the user know our macro has finished!
    MsgBox "Data transferred!"

End Sub

enter image description here

Samuel Everson
  • 2,097
  • 2
  • 9
  • 24
ifwa
  • 15
  • 4
  • 1
    What code? Your problem is difficult to understand. – Paul Ogilvie Jun 08 '21 at 12:03
  • This code below from dan wagner seems to do everything i want but i cant seem to understand how i make it just copy into an exsiting sheet i already have – ifwa Jun 08 '21 at 12:11
  • Ive just pasted the code i got from dan wagner in the main body of the message – ifwa Jun 08 '21 at 12:13
  • What is wrong with the code, it looks to do everything you described? – Samuel Everson Jun 08 '21 at 12:14
  • 1
    it creates a new workbook rather than pasting into the existing tab i have created for it and also there is no data i cant seem to understand what part of the code i need to chaneg to point it to my data table – ifwa Jun 08 '21 at 12:17
  • im sorry i am a noob but i have tried for soo long to figure it out – ifwa Jun 08 '21 at 12:18
  • To add the code to your sheet: open VBA editor; click Insert, Module; paste the code in the module and try to run it. – Paul Ogilvie Jun 08 '21 at 12:18
  • hi ive tried to run it ...which part of the code do i need to change so that the tab where the data pulls from reads "branch consolidated master" and which part of the code do i need to change so that it pastes data into the "date extract" tab – ifwa Jun 08 '21 at 12:20

3 Answers3

0

What this solution does:

  • Assumes your dates are in Column A of your worksheet.
  • Can be used to replace the CreateSubsetWorkbook sub you have.

You can still use the PromptUserForInputDates and then call this sub instead of CreateSubsetWorkbook.

Public Sub FillOutputRange(ByVal StartDate As Date, ByVal EndDate As Date)
    Dim SourceSheet As Worksheet
    Dim DestinationSheet As Worksheet
    Dim TargetCell As Range
    Dim LastRow As Long
    Dim StartRow As Long
    Dim EndRow As Long
    Dim RowLoopCounter As Long
    Dim EndColumn As Long
    Dim OutputDataArray As Variant
    
    With ThisWorkbook
        Set SourceSheet = .Sheets("Sheet1")         'Change this to the name of your source sheet
        Set DestinationSheet = .Sheets("Sheet2")   'Change this to the name of your destination sheet
    End With
    
    With SourceSheet
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        
        For Each TargetCell In .Range("A1:A" & LastRow)
            If TargetCell.Value = StartDate Then
                StartRow = TargetCell.Row
                Exit For
            End If
        Next TargetCell
        If StartRow = 0 Then MsgBox "Start Date was not found", vbOKOnly, "No Start Date": Exit Sub
        
        For RowLoopCounter = LastRow To StartRow Step -1
            If .Range("C" & RowLoopCounter).Value = EndDate Then
                EndRow = RowLoopCounter
                Exit For
            End If
        Next RowLoopCounter
        If EndRow = 0 Then MsgBox "End Date was not found", vbOKOnly, "No End Date": Exit Sub
        
        EndColumn = .Cells(EndRow, .Columns.Count).End(xlToLeft).Column
       
       OutputDataArray = .Range(.Cells(StartRow, "A"), .Cells(EndRow, EndColumn)).Value
    End With
     
    With DestinationSheet
        .Range("C8").Resize(UBound(OutputDataArray, 1), UBound(OutputDataArray, 2)).Value = OutputDataArray
    End With
    
End Sub

How does it work?

The flow of this sub can be described as:

  • First we set variables to use as reference to our SourceSheet and DestinationSheet - Be sure to change these to the correct worksheet names for your workbook.
  • Then with the SourceSheet we find the LastRow - see "Better way to find last row"
  • Then we use a For Each Next Statement to loop through each cell in the Range("A1:A" & LastRow") - If LastRow is say, 10 then this would be equivalent to Range("A1:A10")
  • With each iteration of the loop we are checking if the cell's value matches our StartDate argument passed from the PromptUserForInputDates Sub.
  • Once we have our first match, we assign the Row of that cell to the StartRow variable and the loop is exited and the code continues.
  • The next loop is a For Next Statement which works with slightly different syntax. I've used this to demonstrate using the different statement. We loop backwards from the end of the range, back to the StartRow so this way the EndRow will be established from the last occurrence of the EndDate in your range.
  • Now that we have the StartRow and EndRow we know which rows the target data are in between (inclusive).
  • EndColumn is found based on the last column with data in the EndRow - you can find this based on any row, I just chose to find it with the end row.
  • Using the 3 variables, StartRow, EndRow, and EndColumn we can build our OutputDataArray by assigning the value of the target range to the array variable. This automatically builds a two dimensional array with all the data in it.
  • Finally, with our DestinationSheet we now write the array to a range in the sheet. I've hard coded this to start at Range("C8") per your question. The Range.Resize Property is used to change the Range size to match the Array size, this way the data from the Array writes directly into the sheet.

This Chip Pearson article is great for learning about Arrays.

Note: I've added If...Then statements after each loop to catch errors that will appear if either of the variables StartRow and/or EndRow are not assigned (meaning they retain their default value of 0). This handles the error by throwing a messagebox to the user advising whichever date hasn't been found.


Demonstration

Based on the following dates being used:

StartDate = 3/6/2021

EndDate = 6/6/2021

Sample Source data:

Sample source data

Outcome of running sub:

Output Demo gif

marc_s
  • 732,580
  • 175
  • 1,330
  • 1,459
Samuel Everson
  • 2,097
  • 2
  • 9
  • 24
  • hi..im getting an error when i try to run "compile error" variable not defined – ifwa Jun 08 '21 at 13:20
  • ont he output data array - .range... line – ifwa Jun 08 '21 at 13:20
  • Also thanks man you are a legend for helping me i couldnt figure it out – ifwa Jun 08 '21 at 13:21
  • @ifwa sorry, I changed the name of the array halfway through, At the top change `Dim SourceDataArray` to `Dim OutputDataArray`. - Answer is edited to reflect this. – Samuel Everson Jun 08 '21 at 13:24
  • thanks, i have a different error message "method ' range' of object_global failed – ifwa Jun 08 '21 at 13:29
  • debug higlights If range ("c" & rowloopcounter).value = enddate then – ifwa Jun 08 '21 at 13:30
  • I changed rnage from A to C ( i tried A but didnt work) – ifwa Jun 08 '21 at 13:30
  • 1
    I just saw the explantions you also provided!! thanks so much for taking the time to post that too...helps me to understand some of the logic but it is still tough man – ifwa Jun 08 '21 at 13:40
  • I'm not able to reproduce that error, but changing the column to `"C"` should cause any issue... let me try and do some testing – Samuel Everson Jun 08 '21 at 13:41
  • @ifwa I've made a typo - try adding a dot `.` in front of `Range` like `.Range("C" & RowLoopCounter)...` – Samuel Everson Jun 08 '21 at 13:43
  • @ifwa I believe the error was due to either the `StartDate` or `EndDate` not being found and the `StartRow` or `EndRow` variable was being used with it's default value of `0` which is not a valid `Row` reference - I've edited in some error checking for this occurance to handle a nice message to the user and exit the sub. – Samuel Everson Jun 08 '21 at 14:04
0
Option Explicit

'This subroutine prompts the user to select dates
Public Sub PromptUserForInputDates()
    
    Dim strStart As String, strEnd As String, strPromptMessage As String
    
    'Prompt the user to input the start date
    strStart = InputBox("Please enter the start date")
    
    'Validate the input string
    If Not IsDate(strStart) Then
        strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                           "date. Please retry with a valid date..."
        MsgBox strPromptMessage
        Exit Sub
    End If
    
    'Prompt the user to input the end date
    strEnd = InputBox("Please enter the end date")
    
    'Validate the input string
    If Not IsDate(strStart) Then
        strPromptMessage = "Oops! It looks like your entry is not a valid " & _
                           "date. Please retry with a valid date..."
        MsgBox strPromptMessage
        Exit Sub
    End If
    
    'Call the next subroutine, which will do produce the output workbook
    Call FillOutputRange(strStart, strEnd)
    
End Sub

Public Sub FillOutputRange(ByVal StartDate As Date, ByVal EndDate As Date)
    Dim SourceSheet As Worksheet
    Dim DestinationSheet As Worksheet
    Dim TargetCell As Range
    Dim LastRow As Long
    Dim StartRow As Long
    Dim EndRow As Long
    Dim RowLoopCounter As Long
    Dim EndColumn As Long
    Dim OutputDataArray As Variant
    
    With ThisWorkbook
        Set SourceSheet = .Sheets("Branches consolidated Master (4")         'Change this to the name of your source sheet
        Set DestinationSheet = .Sheets("Date Extract (5)")   'Change this to the name of your destination sheet
    End With
    
    With SourceSheet
        LastRow = .Cells(Rows.Count, "C").End(xlUp).Row
        
        For Each TargetCell In .Range("C8:C" & LastRow)
            If TargetCell.Value = StartDate Then
                StartRow = TargetCell.Row
                Exit For
            End If
        Next TargetCell
        
        For RowLoopCounter = LastRow To StartRow Step -1
            If Range("C" & RowLoopCounter).Value = EndDate Then
                EndRow = RowLoopCounter
                Exit For
            End If
        Next RowLoopCounter
        
        EndColumn = .Cells(EndRow, .Columns.Count).End(xlToLeft).Column
       
       OutputDataArray = .Range(.Cells(StartRow, "A"), .Cells(EndRow, EndColumn)).Value
    End With
     
    With DestinationSheet
        .Range("C8").Resize(UBound(OutputDataArray, 1), UBound(OutputDataArray, 2)).Value = OutputDataArray
    End With
    
End Sub

enter image description here

Samuel Everson
  • 2,097
  • 2
  • 9
  • 24
ifwa
  • 15
  • 4
0

my code error

Error says application defined or object defined error

Sorry for all the trouble @samuel

ifwa
  • 15
  • 4