VBA script to copy data based on Cell criteria

Kthom019 · May 10th 2019

How can I write a VBA script to copy data from a column and paste it into another worksheet based on a criteria in a cell?

Example: Assuming the table below = RowsA6 : F6. Cell C1 = the current month.
I would like to copy from another worksheet, which looks like the one below, actual data for only column B (Apr). Monthly, I would change Cell C1 to read the current month.
And of course copy only data for that current month. So, in May, I want only need to update column C, with Actual for May and so on and so forth.

[TABLE="border: 1, cellpadding: 1, width: 500"]

[tr]

[td][/td]

[td]

Apr

[/td]

[td][/td]

[/tr]

[tr]

[td]

Description

[/td]

[td]

Apr

[/td]

[td]

May

[/td]

[td]

Jun

[/td]

[td]

Jul

[/td]

[td]

Aug

[/td]

[/tr]

[tr]

[td][/td]

[/tr]

[tr]

[td][/td]

[/tr]

[tr]

[td][/td]

[/tr]

[tr]

[td][/td]

[/tr]

[/TABLE]

Mumps · May 11th 2019

It would be easier to help and test possible solutions if you could attach a copy of your file. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using examples from your data.

Kthom019 · May 11th 2019

Okay, How do I attached a copy of the file? The attachment only refers to URL links.

Mumps · May 11th 2019

Click the paperclip icon in the upper right of the menu to the left of the "A" in your response.

Kthom019 · May 11th 2019

Thank you. See the attachment.

Mumps · May 11th 2019

Just a few questions for clarification:
- Are columns B, C and D in the "Update Cur" sheet the values for JEEP, BARN & TRACK respectively?
- Each of the 3 sheets JEEP, BARN & TRACK currently has values for each month. Do you want the values from the [SIZE=13px]"[/SIZE][SIZE=13px]Update Cur" sheet to replace the values in the other 3 sheets or to be added to the values that are currently there?[/SIZE]

[SIZE=13px]-Does the data in the [/SIZE][SIZE=13px]"[/SIZE][SIZE=13px]Update Cur" sheet actually start with the headers in row 5 and the other 3 sheets with the headers in row 4?[/SIZE]

Kthom019 · May 11th 2019

Just a few questions for clarification:
- Are columns B, C and D in the "Update Cur" sheet the values for JEEP, BARN & TRACK respectively? Yes, the values are for each sheet respectively.
- Each of the 3 sheets JEEP, BARN & TRACK currently has values for each month. Do you want the values from the "Update Cur" sheet to replace the values in the other 3 sheets or to be added to the values that are currently there? The values in Column C "Apr", should be replaced with the values from the "Update Cur" sheet. Monthly I will change Cell "I2" to show the current month to be updated.
-Does the data in the "Update Cur" sheet actually start with the headers in row 5 and the other 3 sheets with the headers in row 4? The header on the "Update Cur" sheet should be in R4, sorry about that.

THANKS MUCH FOR HELPING!

Mumps · May 12th 2019

Try:

Code

Sub CopyData()
    Application.ScreenUpdating = False
    Dim month As Range, fnd As Range, srcWS As Worksheet
    Set month = Sheets("Jeep").Range("I2")
    Set srcWS = Sheets("Update Cur")
    Set fnd = Sheets("Jeep").Rows(4).Find(month, LookIn:=xlValues, lookat:=xlWhole)
    With Sheets("Jeep")
        .Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("B6:B11").Value
        .Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("B14:B27").Value
    End With
    With Sheets("Barn")
        .Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("C6:C11").Value
        .Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("C14:C27").Value
    End With
    With Sheets("Track")
        .Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("D6:D11").Value
        .Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("D14:D27").Value
    End With
    Application.ScreenUpdating = True
End Sub

Display More

Kthom019 · May 13th 2019

This is absolutely brilliant! It works perfectly. I even added another sheet adjusted the code and it was brilliant. Thanks a million times.

Quote from Mumps

Try:

Code

Sub CopyData()
Application.ScreenUpdating = False
Dim month As Range, fnd As Range, srcWS As Worksheet
Set month = Sheets("Jeep").Range("I2")
Set srcWS = Sheets("Update Cur")
Set fnd = Sheets("Jeep").Rows(4).Find(month, LookIn:=xlValues, lookat:=xlWhole)
With Sheets("Jeep")
.Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("B6:B11").Value
.Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("B14:B27").Value
End With
With Sheets("Barn")
.Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("C6:C11").Value
.Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("C14:C27").Value
End With
With Sheets("Track")
.Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("D6:D11").Value
.Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("D14:D27").Value
End With
Application.ScreenUpdating = True
End Sub

Display More

Mumps · May 13th 2019

You are very welcome.

Kthom019 · Jun 5th 2019

Hi [USER="138669"]Mumps[/USER], I crave your assistance with another macro, on this same work file. I will now have another workbook, named forecast, which should update these sheets but only for the other months. E.g. If actual is April, the forecast should update from May to March. Should I send the forecast file.

Mumps · Jun 6th 2019

Please post a copy of the file and explain in detail what you want to do referring to specific cells, rows, columns and sheets using examples from your data.

Kthom019 · Jun 7th 2019

Thanks.
Each month the Actual will be updated from the "Update Cur" sheet in the 'P&L Actual-Forecast' workbook. Likewise, the other forecasted months should be updated from individual workbooks.
example:
April is update from the first macro to show the actual information
May to Mar should be updated from the individual forecast files

In May
May is update from the first macro to show the actual information
June to Mar should be updated from the individual forecast files

In June
June is update from the first macro to show the actual information
July to Mar should be updated from the individual forecast files

In July
July is update from the first macro to show the actual information
August to Mar should be updated from the individual forecast files

In August
August is update from the first macro to show the actual information
September to Mar should be updated from the individual forecast files

In September
September is update from the first macro to show the actual information
October to Mar should be updated from the individual forecast files

and so on until Mar is update with Actual information from the "Update Cur" sheet.

Next year the cycle continues.

The other two attachments will follow due to the limit on attachments.

Kthom019 · Jun 7th 2019

Other files attached. The forecast files will always be in separate workbooks.

Mumps · Jun 8th 2019

Will the

individual forecast workbooks always be open or does the macro have to open them?

Kthom019 · Jun 8th 2019

Quote from Mumps

Will the
individual forecast workbooks always be open or does the macro have to open them?

They will always be open.

Mumps · Jun 9th 2019

In sheet "Update Cur" in your P&amp workbook, move all your data up so it starts on row 4 instead of row 5. Place the macro in the [SIZE=13px]P&amp workbook and with all the workbooks open, run the macro.[/SIZE]

Code

Sub CopyData()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim month As Range, fnd As Range, srcWS As Worksheet, WB As Workbook
    Set month = Sheets("Jeep").Range("I2")
    Set srcWS = Sheets("Update Cur")
    Set fnd = Sheets("Jeep").Rows(4).Find(month, LookIn:=xlValues, lookat:=xlWhole)
    With Sheets("Jeep")
        .Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("B6:B11").Value
        .Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("B14:B27").Value
        For Each WB In Workbooks
            If WB.Name Like "Jeep*" Then
                .Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value = WB.Sheets("Jeep").Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value
                .Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value = WB.Sheets("Jeep").Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value
                Exit For
            End If
        Next WB
    End With
    With Sheets("Barn")
        .Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("C6:C11").Value
        .Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("C14:C27").Value
        For Each WB In Workbooks
            If WB.Name Like "Barn*" Then
                .Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value = WB.Sheets("Barn").Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value
                .Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value = WB.Sheets("Barn").Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value
                Exit For
            End If
        Next WB
    End With
    With Sheets("Track")
        .Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("D6:D11").Value
        .Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("D14:D27").Value
        For Each WB In Workbooks
            If WB.Name Like "Track*" Then
                .Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value = WB.Sheets("Track").Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value
                .Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value = WB.Sheets("Track").Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value
                Exit For
            End If
        Next WB
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Display More

Kthom019 · Jun 9th 2019

Thanks, it works well. However, I want the actions separated. I want to keep the first Macro you gave me and have this new one only to update the forecast. I will have separate buttons to reflect both Macros.

How do I modify to have them separated?

Mumps · Jun 10th 2019

Try:

Code

Sub UpDateForecast()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim rMonth As Range, fnd As Range, WB As Workbook
    Set rMonth = Sheets("Jeep").Range("I2")
    Set fnd = Sheets("Jeep").Rows(4).Find(rMonth, LookIn:=xlValues, lookat:=xlWhole)
    With Sheets("Jeep")
        For Each WB In Workbooks
            If WB.Name Like "Jeep*" Then
                .Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value = WB.Sheets("Jeep").Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value
                .Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value = WB.Sheets("Jeep").Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value
                Exit For
            End If
        Next WB
    End With
    With Sheets("Barn")
        For Each WB In Workbooks
            If WB.Name Like "Barn*" Then
                .Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value = WB.Sheets("Barn").Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value
                .Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value = WB.Sheets("Barn").Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value
                Exit For
            End If
        Next WB
    End With
    With Sheets("Track")
        For Each WB In Workbooks
            If WB.Name Like "Track*" Then
                .Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value = WB.Sheets("Track").Cells(6, fnd.Column + 1).Resize(6, 15 - fnd.Column).Value
                .Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value = WB.Sheets("Track").Cells(14, fnd.Column + 1).Resize(14, 15 - fnd.Column).Value
                Exit For
            End If
        Next WB
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
Sub CopyData()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim rMonth As Range, fnd As Range, srcWS As Worksheet
    Set rMonth = Sheets("Jeep").Range("I2")
    Set srcWS = Sheets("Update Cur")
    Set fnd = Sheets("Jeep").Rows(4).Find(rMonth, LookIn:=xlValues, lookat:=xlWhole)
    With Sheets("Jeep")
        .Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("B6:B11").Value
        .Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("B14:B27").Value
    End With
    With Sheets("Barn")
        .Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("C6:C11").Value
        .Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("C14:C27").Value
    End With
    With Sheets("Track")
        .Cells(6, fnd.Column).Resize(6).Value = srcWS.Range("D6:D11").Value
        .Cells(14, fnd.Column).Resize(14).Value = srcWS.Range("D14:D27").Value
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Display More

Kthom019 · Jun 11th 2019

Thank you MUMPS. Much Appreciated.

VBA script to copy data based on Cell criteria

Participate now!

Share