VBA - copy values based on month from one set of cells to another and then auto sort chronologically

[psaycolo]

Hello all. I am looking for a formula for a button that will take the date values that are in column K and reference whether they are the current month, then copy the ones that are for the current month into cells B17:B33, and if they are the next month into cells B36:B65. These dates also have text that needs to stay with it in column I that would need to copy over to column C. Once everything is copied over, it needs to sort itself chronologically while still keeping the dates and text together. I am new to VBA and have been trying to figure this out for about 2 weeks and have honestly gotten nowhere. PLEASE HELP!

 

[JLGWhiz]

Try this

Sub t()
Dim c As Range, sKey1 As Range, sKey2 As Range
    With ActiveSheet
        For Each c In .Range("K2", .Cells(Rows.Count, 11).End(xlUp))
            If Month(c.Value) = Month(Date) Then
                If .Range("B17") = "" Then
                    .Range("B17") = c.Value
                    .Range("C17") = c.Offset(, -2).Value
                Else
                    .Cells(34, 2).End(xlUp)(2) = c.Value
                    .Cells(34, 2).End(xlUp).Offset(, 1) = c.Offset(, -2).Value
                End If
            ElseIf Month(c.Value) = Month(Date) + 1 Then
                If .Range("B36") = "" Then
                    .Range("B36") = c.Value
                    .Range("C36") = c.Offset(, -2).Value
                Else
                    .Cells(66, 2).End(xlUp)(2) = c.Value
                    .Cells(66, 2).End(xlUp).Offset(, 1) = c.Offset(, -2).Value
                End If
            End If
        Next
        Set sKey1 = .Range("C17", .Cells(34, 3).End(xlUp))
        Set sKey2 = .Range("C36", .Cells(66, 3).End(xlUp))
        .Range("B17", .Cells(34, 3).End(xlUp)).Sort .Range("C17"), xlAscending, Header:=xlNo
        .Range("B36", .Cells(66, 3).End(xlUp)).Sort .Range("C36"), xlAscending, Header:=xlNo
    End With
End Sub

 

[psaycolo]

It says Type Mismatch for this line:
If Month(c.Value) = Month(Date) Then

 

[JLGWhiz]

Try changing that line to:

If Month(CDate(c.Value)) = Month(Date) Then

Apparently what you are calling a date in column K is not really a date. Can you post an image of the sheet?

 

[psaycolo]

That didn't work either, same error. I have those cells formatted as a date though so I'm not sure why it would say they aren't really dates.

 

[JLGWhiz]

I see now why it is not working. You have merged cells all over the sheet, plus a lot of blank rows in column K. The blank row can be handled but the merged cells give VBA a fit to work with. I don't know how to get around that. Sorry
Regards, JLG

 

[psaycolo]

I see now why it is not working. You have merged cells all over the sheet, plus a lot of blank rows in column K. The blank row can be handled but the merged cells give VBA a fit to work with. I don't know how to get around that. Sorry
Regards, JLG

Would it work with this layout? Or do the remaining merged cells still stop it from working? If I set it up this way would that work, or would I need to remove merged cells all together?

 

[JLGWhiz]

Put some data in it and try it with the code below which has been modified to ignore blank rows in column K.

Sub t3()
Dim c As Range, sKey1 As Range, sKey2 As Range
    With ActiveSheet
        For Each c In .Range("K5", .Cells(Rows.Count, 11).End(xlUp))
            If c <> "" Then
                If Month(c.Value) = Month(Date) Then
                    If .Range("B17") = "" Then
                        .Range("B17") = c.Value
                        .Range("C17") = c.Offset(, -2).Value
                    Else
                        .Cells(34, 2).End(xlUp)(2) = c.Value
                        .Cells(34, 2).End(xlUp).Offset(, 1) = c.Offset(, -2).Value
                    End If
                ElseIf Month(c.Value) = Month(Date) + 1 Then
                    If .Range("B36") = "" Then
                        .Range("B36") = c.Value
                        .Range("C36") = c.Offset(, -2).Value
                    Else
                        .Cells(66, 2).End(xlUp)(2) = c.Value
                        .Cells(66, 2).End(xlUp).Offset(, 1) = c.Offset(, -2).Value
                    End If
                End If
            End If
        Next
        Set sKey1 = .Range("C17", .Cells(34, 3).End(xlUp))
        Set sKey2 = .Range("C36", .Cells(66, 3).End(xlUp))
        .Range("B17", .Cells(34, 3).End(xlUp)).Sort .Range("C17"), xlAscending, Header:=xlNo
        .Range("B36", .Cells(66, 3).End(xlUp)).Sort .Range("C36"), xlAscending, Header:=xlNo
    End With
End Sub

 

[psaycolo]

The very last "Next" in the code popped as a "Next without For"

 

[psaycolo]

Put some data in it and try it with the code below which has been modified to ignore blank rows in column K.

Sub t3()
Dim c As Range, sKey1 As Range, sKey2 As Range
    With ActiveSheet
        For Each c In .Range("K5", .Cells(Rows.Count, 11).End(xlUp))
            If c <> "" Then
                If Month(c.Value) = Month(Date) Then
                    If .Range("B17") = "" Then
                        .Range("B17") = c.Value
                        .Range("C17") = c.Offset(, -2).Value
                    Else
                        .Cells(34, 2).End(xlUp)(2) = c.Value
                        .Cells(34, 2).End(xlUp).Offset(, 1) = c.Offset(, -2).Value
                    End If
                ElseIf Month(c.Value) = Month(Date) + 1 Then
                    If .Range("B36") = "" Then
                        .Range("B36") = c.Value
                        .Range("C36") = c.Offset(, -2).Value
                    Else
                        .Cells(66, 2).End(xlUp)(2) = c.Value
                        .Cells(66, 2).End(xlUp).Offset(, 1) = c.Offset(, -2).Value
                    End If
                End If
            End If
        Next
        Set sKey1 = .Range("C17", .Cells(34, 3).End(xlUp))
        Set sKey2 = .Range("C36", .Cells(66, 3).End(xlUp))
        .Range("B17", .Cells(34, 3).End(xlUp)).Sort .Range("C17"), xlAscending, Header:=xlNo
        .Range("B36", .Cells(66, 3).End(xlUp)).Sort .Range("C36"), xlAscending, Header:=xlNo
    End With
End Sub

Nevermind that was something i accidentally did