Copy select columns from a row given a criteria was met

Closed
Voarkin Posts 1 Registration date Saturday January 10, 2015 Status Member Last seen January 10, 2015 - Jan 10, 2015 at 07:10 PM
vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 - Jan 13, 2015 at 12:36 AM
I have been working for quite a while on a spread sheet for a productivity tracker. I have tried to copy and past several codes and editing them, but I have never used the VB side of excel and haven't used VB since high school. What I need is the following:

Data from Sheet "Daily Log" in columns "C:E" to be copied to Sheet "ACD Call Log" if Column "A" = "ACD",
Data from Sheet "Daily Log" in columns "C:E" to be copied to Sheet "In-Store Log" if Column "A" = "Walk-in",
and Data from Sheet "Daily Log" in columns "C:E" to be copied to Sheet "ACD Call Log" and "In-Store Log" if Column "A" = "Both"

In all three scenarios, the code must past to the new sheet staring in A2, as I have a header on all sheets. Also if I could know how to make the script run ie full coding.

Thank you

1 response

vcoolio Posts 1411 Registration date Thursday July 24, 2014 Status Moderator Last seen September 6, 2024 262
Jan 13, 2015 at 12:36 AM
Hello Voarkin,

Perhaps the following code may help:-


Sub TransferIt()
Application.ScreenUpdating = False
Dim lRow As Long
Sheets("Daily Log").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each Cell In Range("A2:A" & lRow)
    If Cell = "ACD" Then
    Range(Cells(Cell.Row, "C"), Cells(Cell.Row, "E")).Copy Sheets("ACD Call Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = "Walk-in" Then
    Range(Cells(Cell.Row, "C"), Cells(Cell.Row, "E")).Copy Sheets("In Store Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    
    ElseIf Cell = "Both" Then
    Range(Cells(Cell.Row, "C"), Cells(Cell.Row, "E")).Copy Sheets("ACD Call Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    Range(Cells(Cell.Row, "C"), Cells(Cell.Row, "E")).Copy Sheets("In Store Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End If
 
Next Cell

Sheets("Daily Log").Range("A2:E" & Rows.Count).ClearContents
MsgBox "Data transfer completed!", vbExclamation
Application.ScreenUpdating = True

End Sub


You can have a look at my test work book here:-

https://www.dropbox.com/s/79nfe8xg4banv6d/Voarkin.xlsm?dl=0

to see if it works for you.

The code also deletes your daily log entries as I have assumed that you would not want your input sheet cluttered up with used data.

The blanks that I have left in the test work book are deliberate.

I hope it helps.

Kind regards,
vcoolio.
2