CODEWITHSUNDEEP
vbaexcel
Kuma
Kuma

Reputation: 57

Search data format and copy and paste

I have a database for one year, in Column A (date), Column B, and corresponding data. Column A has yyyy/mm/dd format. Currently I am using the following code, which can specify a range to copy across. Now I want to improve it to be used for search, and copy the current month data (Column A and B). Any help is highly appreciated. Thank you. 

Sub CopyRange()
    Dim FromRange As Range
    Dim ToRange As Range
    Dim Str As String
    Set FromRange = Application.InputBox("Enter The Range Want to Copy", "Update   ", "data!", Type:=8)
    Set ToRange = Application.InputBox("Enter The Range Want to Copy", "Update", "Chart!", Type:=8)

    FromRange.Copy ToRange
End Sub

Sub FindMonth()
Dim LastRow, matchFoundIndex, iCntr As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For iCntr = 1 To LastRow             ' 1 set the start of the dup looks
If Cells(iCntr, 1) <> "" Then
matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" &   LastRow), 0)
If iCntr <> matchFoundIndex Then
Cells(iCntr, 10) = "same"
End If
End If
Next
End Sub                                                                                                                           This code helps to select  same date, need to modify to select same month.

Upvotes: 0

Views: 45

Answers (1)

YowE3K
YowE3K

Reputation: 23974

The function below should be able to take a string parameter (e.g. "2016/12" or Format(Now(), "yyyy/mm") and will return the range (within ActiveSheet - change that to suit your needs) starting with the first row for the month, and ending at the last row for the month.

Function FindMonth(mth As String) As Range
    Dim rngStart As Range
    Dim rngEnd As Range
    With ActiveSheet 'assume ActiveSheet for the moment
        'Find first occurrence
        Set rngStart = .Columns("A").Find(What:=mth, _
                                          After:=.Cells(.Rows.Count, 1), _
                                          LookIn:=xlValues, _
                                          LookAt:=xlPart, _
                                          SearchDirection:=xlNext)
        If rngStart Is Nothing Then
            Set FindMonth = Nothing
        Else
            'Find the last occurrence
            Set rngEnd = .Columns("A").Find(What:=mth, _
                                            After:=rngStart, _
                                            LookIn:=xlValues, _
                                            LookAt:=xlPart, _
                                            SearchDirection:=xlPrevious)
            'Return columns A:B for the rows selected
            Set FindMonth = .Range(.Cells(rngStart.Row, "A"), .Cells(rngEnd.Row, "B"))
        End If
    End With
End Function

The assumption is that all data for a single month is in a contiguous section.

The function could be called as follows

Sub CopyRange()
    Dim FromRange As Range
    Dim ToRange As Range
    Dim Str As String
    Set FromRange = FindMonth("2016/12")
    If FromRange Is Nothing Then
        MsgBox "No data found!"
        Exit Sub
    End If
    Set ToRange = Application.InputBox("Enter The Range Want to Copy", "Update", "Chart!", Type:=8)

    FromRange.Copy ToRange.Cells(1, 1).Address 'Changed to just specify top-left corner of destination
End Sub

Upvotes: 0

Related Questions