MobileMobile | Continue

Excel Bar

Excel Bar

Your excel questions will be responsed by our excel experts within 24hrs.Our service is free.

 Forgot Pass?
 Register Now
Find
Hot Search: Vlookup Match VBA
12Next
Return Post new threads
View: 515|Reply: 10

Help to transfer data from one sheet to another [SOLVED]

[Copy link]

3

Topics

110

Posts

255

Integral

Conqueror

Rank: 3Rank: 3

Integral
255
Post on 2-11-2017 19:14:49 | All posts |Read mode
Hi All
I am hoping that you can help me find a macro for the following, to help make a long process nice and simple. I need to be able to take data from one sheet and copy and paste it to another - but with a catch. the first sheet contains a list of names and the days of the week (Monday to Sunday) against each name is the person availability with unavailable days enter as an 'U'.
What I would like to be able to do is take this information and copy it across to another sheet which lists all the same names and the days they are unavailable for the following six months. in a ideal world when this information is copied across only the 'U' would be copied across and any data already entered onto the calendar would be left in place and not overwritten (is this last bit possible?)
Thanks for any help you will be able to give
Chris















  • Example.xlsx
    (19.3 KB, 14 views)
    Download
















  • Reply

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
     Author| Post on 2-11-2017 20:46:12 | All posts



    Hi CJ,
    Consider this code that allows the user to select the days unavailable (U) on the Details sheet for a person.  The person's schedule on the Availability sheet will automatically be updated as the user enters the data.  Unavailable days will be transferred across while not overwriting data if it exists.  Removing an unavailable day on the Details sheet will remove all the unavailability's for that weekday across the board for that person.  Also added is the conditional formatting on both sheets.
    Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Target.Count  2 Then Exit Sub
    '---------------------------------------
    'DECLARE AND SET VARIABLES

    Dim Keyword As Range, NextKeyword As String
    Dim Row As Long, Col As Long, x As Long
    Dim AvailDay As String, nme As String
    Row = Target.Row
    Col = Target.Column
    LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    With Worksheets(Availability)
    '---------------------------------------
    'TEST IF CELL CHANGED WAS IN dATILS WEEKLY MATRIX

        If Not Intersect(Target, Range(C4:I  LastRow)) Is Nothing Then
            AvailDay = Cells(3, Col)
            nme = Cells(Row, 2)
    '---------------------------------------
    'FIND FIRST INSTANCE MATCHING WEEKDAY:NAME CELL ON AVAILIBILITY SHEET

            Set Keyword = .UsedRange.Find(What:=AvailDay)
            .Select
            EndRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            Keyword.Select
            NextKeyword = Keyword.Address
            x = WorksheetFunction.Match(nme, .Range(A1:A  EndRow), 0)
    '---------------------------------------
    'COPY OVER VALUE

            If .Cells(x, Keyword.Column) =  Or .Cells(x, Keyword.Column) = U Then
                .Cells(x, Keyword.Column) = Target
            End If
    '---------------------------------------
    'FIND SUBSEQUENT INSTANCES MATCHING WEEKDAY:NAME CELL ON AVAILIBILITY SHEET
            Do
                Set Keyword = .UsedRange.FindNext(after:=Keyword)
                If NextKeyword  Keyword.Address Then
                    Keyword.Select
    '---------------------------------------
    'COPY OVER VALUE

                    If .Cells(x, Keyword.Column) =  Or .Cells(x, Keyword.Column) = U Then
                        .Cells(x, Keyword.Column) = Target
                    End If
                End If
            Loop While Not Keyword Is Nothing And Keyword.Address  NextKeyword
        End If
    End With
    Worksheets(Details).Select
    '---------------------------------------
    'CLEANUP

    Set Keyword = Nothing
    Set Target = Nothing
    Application.ScreenUpdating = True
    End Sub








  • CJW.xlsm
    (66.2 KB, 19 views)
    Download














  • Reply Support Opposition

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
     Author| Post on 2-11-2017 22:16:27 | All posts



    Thank you - that is very clever just what I was after. (I would have never gotten that!) Although is it possible when checking what day of the week it is that instead of using Mon, Tue as the reference ,can we use the value from a formula, as ideally the availability sheet will use a formula (weekday) to show what day of the week it is.
    Thanks again




    Reply Support Opposition

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
     Author| Post on 2-11-2017 23:25:26 | All posts



    Sure, change the following line in the code:
    AvailDay = Cells(3, Col)
    to
    AvailDay = Choose(weekday(date), Sun, Mon, Tue, Wed, Thu, Fri, Sat)Maud




    Reply Support Opposition

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
     Author| Post on 2-12-2017 00:03:42 | All posts



    thanks for the quick reply, I have replaced the line of code and amended the datasheet to the formats I need to use, but I get a debug error. I have attached a copy of what I have done - can you advise?
    thanks once again.








  • CJW2.xlsm
    (60.9 KB, 5 views)
    Download








  • Reply Support Opposition

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
     Author| Post on 2-12-2017 00:17:00 | All posts



    CJ,
    On the Availability sheet, the header was changed to formulas and formats.  Row 1 header used to be the days of the week (Sun, Mon, Tue, etc.) and is now converted to a date (1/1/2017, 1/2/2107, etc.) which displays a weekday with a ddd format.  So when the code searches for Sun, it can't find it (ERROR).  Rows 2,3,and 4 are different formats of row 1 to show the day (dd), month (mmm), and the year (yyyy).  
    To correct the problem, replace row 1 with the text of the weekdays (Mon, Tue, etc) going across.  In row 2 you can enter the full date starting at 1/1/2017 like you did in row 1 and drag across.  Since it is formatted as dd, it will appear as you want.  Now have header rows 3 and 4 equal to row 2 (instead of 1) and they will appear as you formatted them.  
    So essentially, row 1 is texted weekdays and rows 2-4 are formatted rows the equals the date in row 2. Since rows 2-4  are not used in the search, their formats/formulas are irrelevant
    the changed formula, AvailDay = Choose(Weekday(date), Sun, Mon, Tue, Wed, Thu, Fri, Sat) was entered in the code literally.  date must be replaced by a value, variable, or cell that evaluates to some date.  If you leave the word date, it will be interpreted as Date function which will always be the current date and the formula will output the weekday of the current date.  Tomorrow it will be different
    The reason that I wrote the code they way I originally did was so that whatever weekday that you marked as unavailable for a person on the Details sheet would carry over and mark all that weekdays unavailable on the Availability sheet throughout the year.  With the new change, if the weekday is not evaluated by the column you entered the U, the code will act independently of which column you entered and use a date that you sent to macro.  So if you select a Mon on the Details sheet, the code may mark every Sat on the Availability sheet because that what was sent to the code
    I hope that explains it better.  If these are must have changes, then I am willing to help you further.  Please give me more detail on how the date (weekday) formula will be determined and sent to the macro.
    Maud




    Reply Support Opposition

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
     Author| Post on 2-12-2017 01:30:34 | All posts



    thank for explanation - you've been more than helpful and what you have provided will work great.
    Reply Support Opposition

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
     Author| Post on 2-11-2017 22:31:03 | All posts



    Hi CJ,
    Consider this code that allows the user to select the days unavailable (U) on the Details sheet for a person.  The person's schedule on the Availability sheet will automatically be updated as the user enters the data.  Unavailable days will be transferred across while not overwriting data if it exists.  Removing an unavailable day on the Details sheet will remove all the unavailability's for that weekday across the board for that person.  Also added is the conditional formatting on both sheets.
    Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Target.Count  2 Then Exit Sub
    '---------------------------------------
    'DECLARE AND SET VARIABLES

    Dim Keyword As Range, NextKeyword As String
    Dim Row As Long, Col As Long, x As Long
    Dim AvailDay As String, nme As String
    Row = Target.Row
    Col = Target.Column
    LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    With Worksheets(Availability)
    '---------------------------------------
    'TEST IF CELL CHANGED WAS IN dATILS WEEKLY MATRIX

        If Not Intersect(Target, Range(C4:I  LastRow)) Is Nothing Then
            AvailDay = Cells(3, Col)
            nme = Cells(Row, 2)
    '---------------------------------------
    'FIND FIRST INSTANCE MATCHING WEEKDAY:NAME CELL ON AVAILIBILITY SHEET

            Set Keyword = .UsedRange.Find(What:=AvailDay)
            .Select
            EndRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            Keyword.Select
            NextKeyword = Keyword.Address
            x = WorksheetFunction.Match(nme, .Range(A1:A  EndRow), 0)
    '---------------------------------------
    'COPY OVER VALUE

            If .Cells(x, Keyword.Column) =  Or .Cells(x, Keyword.Column) = U Then
                .Cells(x, Keyword.Column) = Target
            End If
    '---------------------------------------
    'FIND SUBSEQUENT INSTANCES MATCHING WEEKDAY:NAME CELL ON AVAILIBILITY SHEET
            Do
                Set Keyword = .UsedRange.FindNext(after:=Keyword)
                If NextKeyword  Keyword.Address Then
                    Keyword.Select
    '---------------------------------------
    'COPY OVER VALUE

                    If .Cells(x, Keyword.Column) =  Or .Cells(x, Keyword.Column) = U Then
                        .Cells(x, Keyword.Column) = Target
                    End If
                End If
            Loop While Not Keyword Is Nothing And Keyword.Address  NextKeyword
        End If
    End With
    Worksheets(Details).Select
    '---------------------------------------
    'CLEANUP

    Set Keyword = Nothing
    Set Target = Nothing
    Application.ScreenUpdating = True
    End Sub








  • CJW.xlsm
    (66.2 KB, 21 views)
    Download














  • Reply Support Opposition

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
     Author| Post on 2-12-2017 02:15:36 | All posts



    thanks for the quick reply, I have replaced the line of code and amended the datasheet to the formats I need to use, but I get a debug error. I have attached a copy of what I have done - can you advise?
    thanks once again.








  • CJW2.xlsm
    (60.9 KB, 7 views)
    Download








  • Reply Support Opposition

    Props Report

    3

    Topics

    110

    Posts

    255

    Integral

    Conqueror

    Rank: 3Rank: 3

    Integral
    255
     Author| Post on 2-12-2017 02:53:18 | All posts



    Hi CJ,
    Consider this code that allows the user to select the days unavailable (U) on the Details sheet for a person.  The person's schedule on the Availability sheet will automatically be updated as the user enters the data.  Unavailable days will be transferred across while not overwriting data if it exists.  Removing an unavailable day on the Details sheet will remove all the unavailability's for that weekday across the board for that person.  Also added is the conditional formatting on both sheets.
    Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    If Target.Count  2 Then Exit Sub
    '---------------------------------------
    'DECLARE AND SET VARIABLES

    Dim Keyword As Range, NextKeyword As String
    Dim Row As Long, Col As Long, x As Long
    Dim AvailDay As String, nme As String
    Row = Target.Row
    Col = Target.Column
    LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    With Worksheets(Availability)
    '---------------------------------------
    'TEST IF CELL CHANGED WAS IN dATILS WEEKLY MATRIX

        If Not Intersect(Target, Range(C4:I  LastRow)) Is Nothing Then
            AvailDay = Cells(3, Col)
            nme = Cells(Row, 2)
    '---------------------------------------
    'FIND FIRST INSTANCE MATCHING WEEKDAY:NAME CELL ON AVAILIBILITY SHEET

            Set Keyword = .UsedRange.Find(What:=AvailDay)
            .Select
            EndRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            Keyword.Select
            NextKeyword = Keyword.Address
            x = WorksheetFunction.Match(nme, .Range(A1:A  EndRow), 0)
    '---------------------------------------
    'COPY OVER VALUE

            If .Cells(x, Keyword.Column) =  Or .Cells(x, Keyword.Column) = U Then
                .Cells(x, Keyword.Column) = Target
            End If
    '---------------------------------------
    'FIND SUBSEQUENT INSTANCES MATCHING WEEKDAY:NAME CELL ON AVAILIBILITY SHEET
            Do
                Set Keyword = .UsedRange.FindNext(after:=Keyword)
                If NextKeyword  Keyword.Address Then
                    Keyword.Select
    '---------------------------------------
    'COPY OVER VALUE

                    If .Cells(x, Keyword.Column) =  Or .Cells(x, Keyword.Column) = U Then
                        .Cells(x, Keyword.Column) = Target
                    End If
                End If
            Loop While Not Keyword Is Nothing And Keyword.Address  NextKeyword
        End If
    End With
    Worksheets(Details).Select
    '---------------------------------------
    'CLEANUP

    Set Keyword = Nothing
    Set Target = Nothing
    Application.ScreenUpdating = True
    End Sub








  • CJW.xlsm
    (66.2 KB, 23 views)
    Download














  • Reply Support Opposition

    Props Report

    12Next
    Return Post new threads

    Points policy of this forum

    Archiver|Mobile|Small dark house|Contact us|Excel Bar

    GMT-5, 9-21-2017 14:35 , Processed in 0.214054 second(s), 20 queries .

    Powered by Discuz! X3

    © 2001-2013 Comsenz Inc.

    !fastreply! Top !return_list!