• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Insert data at end of list in other sheet

IKHAN

Member
Need help with code below -

1.If any new name is added to pre existing data or new entry in column C (2.planning) to always add to end of list in col D and E Sheet (4. mobile)

2.If data deleted from sheet(2. planning) column C -must delete complete row in sheet (4. mobile)

see attached testfile :

Try adding new name from drop down list sheet 2.planning column C row 13 - New name selected should be end of list in 4. mobile (Currently it inserts row inbetween existing rows)

Code:
Private Sub Worksheet_Activate()
    Dim r As Range, a, i As Long, e, x
    Application.EnableEvents = False
    With Sheets("2. Planning")
        If .Range("c" & Rows.Count).End(xlUp).Row > 12 Then
            a = .Range("c12", .Range("c" & Rows.Count).End(xlUp)).Resize(, 2).Value
        End If
    End With
    If IsArray(a) Then
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                a(i, 1) = Application.Trim(a(i, 1))
                If a(i, 1) <> "" Then
                    For Each e In Split(a(i, 1), ";")
                        x = Split(Application.Trim(e))
                        ReDim Preserve x(1)
                        .Item(Trim$(e)) = x
                    Next
                End If
            Next
            a = Application.Index(.items, 0, 0): i = .Count
        End With
    End If
    With [d18:e18]
        .Resize(Rows.Count - .Row - 1).ClearContents
        If IsArray(a) Then
            .Resize(i).Value = a
        End If
    End With
    Application.EnableEvents = True
End Sub
 

Attachments

  • testfile.xlsm
    39 KB · Views: 12
Any name added after ; in column C in 2.planning should be added end of row in 4.mobile column D and E and any name removed in column C should delete entire row in 4 .mobile .

Hope have explained it properly .. Attached sample sheet
 
Hummm...
I just don't understand want you are trying to do and I found strange behavior in "2.planning"....
 
@jindon

Perhaps, Didn't convey msg properly..

Will break it down..
1.Any new name entered or appended later in "2. planning sheet column C" must always write to end of list in "4. Mobile D and E"

2. If any name deleted from "2. planning sheet column C" MUST delete complete ROW in "4. Mobile D and E"

Reason being data is pulled from third sheet for names populated in "4. Mobile D and E" in columns(A B C F G) and if any missing data have to enter manually.

With your code , If any data entered manually in 4. mobile any column(A B C F G) and name deleted\appended in "2. planning sheet column C" theres mismatch with details coz code is executing only on columns D and E
 
Still not clear.

How do you delete/add name(s) in "2. planning sheet column C"?
I said "I found strange behavior in "2.planning"....".
Are you adding like that?
 
Code:
Private Sub Worksheet_Activate()
    Dim r As Range, a, i As Long, e, x
    Application.EnableEvents = False
    With Sheets("2. Planning")
        If .Range("c" & Rows.Count).End(xlUp).Row > 12 Then
            a = .Range("c12", .Range("c" & Rows.Count).End(xlUp)).Resize(, 2).Value
        End If
    End With
    If IsArray(a) Then
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                a(i, 1) = Application.Trim(a(i, 1))
                If a(i, 1) <> "" Then
                    For Each e In Split(a(i, 1), ";")
                        x = Split(Application.Trim(e))
                        ReDim Preserve x(1)
                        .Item(Trim$(e)) = x
                    Next
                End If
            Next
            a = Application.Index(.items, 0, 0): i = .Count
        End With
    End If
    With [d18:e18]
        .Resize(Rows.Count - .Row - 1).ClearContents
        If IsArray(a) Then
            .Resize(i).Value = a
        End If
    End With
    Application.EnableEvents = True
End Sub
@jindon

Adding by selecting name from dropdown menu or by typing in name in column C

If another name is selected in row 13 groups column (stephen bog), It should write new name at the bottom of list 4. mobile below (don jas).

And also if any name is deleted from column C , entire ROW must be deleted from 4. mobile.

Uploading test file and code provided (Not sure what you mean by strange behaviour in 2. planning)

Thanks for helping out
 

Attachments

  • testfile.xlsm
    39 KB · Views: 4
Last edited:
Hello Ninja's

Have deadline to meet , code was provided by Jindon.Need help to do few corrections


1.If any name is selected by dropdown menu in "2. planning sheet column C" must always write to end of list in "4. Mobile D and E"

In attached sheet example, If another name is selected from drop down in C13 , Name is copied to "4. Mobile D and E row 19" and there's mismatch of name and number.(Note Sam whitby - number 519 416 7654 gets moved to next row)

2. If any name deleted from "2. planning sheet column C" MUST delete complete ROW in "4. Mobile D and E"
 

Attachments

  • testfile.xlsm
    39 KB · Views: 6
As I have already said, your dropdown behave really strange.

It will add to the cell when you select different item from dropdown.

If add like this, how can you identify the data which is new/old?
 
@jindon

Can the code me modified/added to select row and copy all formulas in that row and insert down

Rows("18:18").Select ' select row number 18
Selection.Copy ' copy it
Selection.Insert Shift:=xlDown ' insert a copy of it




Code:
Private Sub Worksheet_Activate()
    Dim r As Range, a, i As Long, e, x
    Application.EnableEvents = False
    With Sheets("2. Planning")
        If .Range("c" & Rows.Count).End(xlUp).Row > 12 Then
            a = .Range("c12", .Range("c" & Rows.Count).End(xlUp)).Resize(, 2).Value
        End If
    End With
    If IsArray(a) Then
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                a(i, 1) = Application.Trim(a(i, 1))
                If a(i, 1) <> "" Then
                    For Each e In Split(a(i, 1), ";")
                        x = Split(Application.Trim(e))
                        ReDim Preserve x(1)
                        .Item(Trim$(e)) = x
                    Next
                End If
            Next
            a = Application.Index(.items, 0, 0): i = .Count
        End With
    End If
    With [d18:e18]
        .Resize(Rows.Count - .Row - 1).ClearContents
        If IsArray(a) Then
            .Resize(i).Value = a
        End If
    End With
    Application.EnableEvents = True
End Sub
 
Hello Guys !!! Any suggestion or help on below code to write data to last row.

Any name selected after " ; " from dropdown menu in"2. Planning" Sheet must always write at the end of row in sheet "4. mobile"



Code:
rivate Sub Worksheet_Activate()
    Dim r As Range, a, i As Long, e, x
    Application.EnableEvents = False
    With Sheets("2. Planning")
        If .Range("c" & Rows.Count).End(xlUp).Row > 12 Then
            a = .Range("c12", .Range("c" & Rows.Count).End(xlUp)).Resize(, 2).Value
        End If
    End With
    If IsArray(a) Then
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                a(i, 1) = Application.Trim(a(i, 1))
                If a(i, 1) <> "" Then
                    For Each e In Split(a(i, 1), ";")
                        x = Split(Application.Trim(e))
                        ReDim Preserve x(1)
                        .Item(Trim$(e)) = x
                    Next
                End If
            Next
            a = Application.Index(.items, 0, 0): i = .Count
        End With
    End If
    With [d18:e18]
        .Resize(Rows.Count - .Row - 1).ClearContents
        If IsArray(a) Then
            .Resize(i).Value = a
        End If
    End With
    Application.EnableEvents = True
End Sub
 

Attachments

  • testfile9.xlsm
    40.6 KB · Views: 4
Back
Top