+ Reply to Thread
Results 1 to 2 of 2

[help with code] need to update existing code to copy and keep rows on input page

Hybrid View

  1. 01-25-2016, 12:36 PM #1
    scott micklo
    scott micklo is offline
    Forum Contributor
    Join Date
    07-08-2015
    Location
    Indiana
    MS-Off Ver
    Excel 2007
    Posts
    128

    [help with code] need to update existing code to copy and keep rows on input page

    Hello all-
    I have been asked to update my code that I am using to now do the following:

    Read data from the tab called 2016 rejects. copy the contents into an existing page that will tabulate the totals from that specific page, AND NOW keep the original data on the input page (called 2016 Rejects).

    Thanks in advance for your assistance.

    I know that the .clearcontents command will need to be taken off each to leave original input data.

    BUT, what code will need to be added, changed, to read the newly input data, and copy it --- NOT the data from before? I have searched and think it will be with my "FOR r= last row of old data +1" will do it. But I am not sure how to store the last line of data read so I know where to pick up with each time.

    Here is the code:

    Sub Macro2()
Dim lr As Long, lr2 As Long, lr3 As Long, lr4 As Long, lr5 As Long, lr6 As Long, lr7 As Long, lr8 As Long, lr9 As Long, lr10 As Long, lr11 As Long, lr12 As Long, lr13 As Long, lr14 As Long, lr15 As Long, lr16 As Long, lr17 As Long, lr18 As Long, lr19 As Long, lr20 As Long, lr21 As Long, lr22 As Long, lr23 As Long, lr24 As Long, lr25 As Long, lr26 As Long, lr27 As Long, lr28 As Long, lr29 As Long, lr30 As Long, lr31 As Long, lr32 As Long, lr33 As Long, lr34 As Long, lr35 As Long, lr36 As Long, r As Long

lr = Sheets("2016 Rejects").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("0088140").Cells(Rows.Count, "A").End(xlUp).Row
lr3 = Sheets("0088165").Cells(Rows.Count, "A").End(xlUp).Row
lr4 = Sheets("0088250").Cells(Rows.Count, "A").End(xlUp).Row
lr5 = Sheets("0040562-01").Cells(Rows.Count, "A").End(xlUp).Row
lr6 = Sheets("0042298-02").Cells(Rows.Count, "A").End(xlUp).Row
lr7 = Sheets("0042326-01").Cells(Rows.Count, "A").End(xlUp).Row
lr8 = Sheets("0042328-01").Cells(Rows.Count, "A").End(xlUp).Row
lr9 = Sheets("0042335-02").Cells(Rows.Count, "A").End(xlUp).Row
lr10 = Sheets("0050613-01").Cells(Rows.Count, "A").End(xlUp).Row
lr11 = Sheets("0053405-01").Cells(Rows.Count, "A").End(xlUp).Row
lr12 = Sheets("0070885-01").Cells(Rows.Count, "A").End(xlUp).Row
lr13 = Sheets("RV2032").Cells(Rows.Count, "A").End(xlUp).Row
lr14 = Sheets("ICHShippers").Cells(Rows.Count, "A").End(xlUp).Row
lr15 = Sheets("41198").Cells(Rows.Count, "A").End(xlUp).Row
lr16 = Sheets("41280").Cells(Rows.Count, "A").End(xlUp).Row
lr17 = Sheets("41281").Cells(Rows.Count, "A").End(xlUp).Row
lr18 = Sheets("41306").Cells(Rows.Count, "A").End(xlUp).Row
lr19 = Sheets("41352").Cells(Rows.Count, "A").End(xlUp).Row
lr20 = Sheets("11211-SEG").Cells(Rows.Count, "A").End(xlUp).Row
lr21 = Sheets("8307").Cells(Rows.Count, "A").End(xlUp).Row
lr22 = Sheets("23317").Cells(Rows.Count, "A").End(xlUp).Row
lr23 = Sheets("083-065-100").Cells(Rows.Count, "A").End(xlUp).Row
lr24 = Sheets("W02-000-001").Cells(Rows.Count, "A").End(xlUp).Row
lr25 = Sheets("11211-SEG-120").Cells(Rows.Count, "A").End(xlUp).Row
lr26 = Sheets("Staminia BTL").Cells(Rows.Count, "A").End(xlUp).Row
lr27 = Sheets("KF-Xb1-D40113A-B").Cells(Rows.Count, "A").End(xlUp).Row
lr28 = Sheets("KTL-Xboxone-LH").Cells(Rows.Count, "A").End(xlUp).Row
lr29 = Sheets("KTL-Xboxone-RH").Cells(Rows.Count, "A").End(xlUp).Row
lr30 = Sheets("KTL-PS4-Tall").Cells(Rows.Count, "A").End(xlUp).Row
lr31 = Sheets("KTL-PS4-Short").Cells(Rows.Count, "A").End(xlUp).Row
lr32 = Sheets("1582").Cells(Rows.Count, "A").End(xlUp).Row
lr33 = Sheets("0075688-01").Cells(Rows.Count, "A").End(xlUp).Row
lr34 = Sheets("Sheet34").Cells(Rows.Count, "A").End(xlUp).Row
lr35 = Sheets("Sheet35").Cells(Rows.Count, "A").End(xlUp).Row
lr36 = Sheets("Sheet36").Cells(Rows.Count, "A").End(xlUp).Row

For r = 2 To lr

Select Case Range("D" & r).Value
Case Is = "0088140"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0088140").Range("A" & lr2 + 1)
lr2 = Sheets("0088140").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "0088165"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0088165").Range("A" & lr3 + 1)
lr3 = Sheets("0088165").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "0088250"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0088250").Range("A" & lr4 + 1)
lr4 = Sheets("0088250").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "0040562-01"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0040562-01").Range("A" & lr5 + 1)
lr5 = Sheets("0040562-01").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "0042298-02"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0042298-02").Range("A" & lr6 + 1)
lr6 = Sheets("0042298-02").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "0042326-01"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0042326-01").Range("A" & lr7 + 1)
lr7 = Sheets("0042326-01").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "0042328-01"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0042328-01").Range("A" & lr8 + 1)
lr8 = Sheets("0042328-01").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "0042335-02"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0042335-02").Range("A" & lr9 + 1)
lr9 = Sheets("0042335-02").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "0050613-01"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0050613-01").Range("A" & lr10 + 1)
lr10 = Sheets("0050613-01").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "0053405-01"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0053405-01").Range("A" & lr11 + 1)
lr11 = Sheets("0053405-01").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "0070885-01"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("0070885-01").Range("A" & lr12 + 1)
lr12 = Sheets("0070885-01").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "RV2032"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("RV2032").Range("A" & lr13 + 1)
lr13 = Sheets("RV2032").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "ICHShippers"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("ICHShippers").Range("A" & lr14 + 1)
lr14 = Sheets("ICHShippers").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "41198"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("41198").Range("A" & lr15 + 1)
lr15 = Sheets("41198").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "41280"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("41280").Range("A" & lr16 + 1)
lr16 = Sheets("41280").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "41281"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("41281").Range("A" & lr17 + 1)
lr17 = Sheets("41281").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "41306"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("41306").Range("A" & lr18 + 1)
lr18 = Sheets("41306").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "41352"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("41352").Range("A" & lr19 + 1)
lr19 = Sheets("41352").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 Rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents

Case Is = "11211-SEG"
Range(Cells(r, 1), Cells(r, 14)).Copy Destination:=Sheets("11211-SEG").Range("A" & lr20 + 1)
lr20 = Sheets("11211-SEG").Cells(Rows.Count, "A").End(xlUp).Row
Sheets("2016 rejects").Range(CStr(r) & ":" & CStr(r)).SpecialCells(xlCellTypeConstants).ClearContents


End Select
Next r
End Sub
    Reply With QuoteRegister To Reply
  2. 01-25-2016, 01:36 PM #2
    stnkynts
    stnkynts is offline
    Forum Expert
    Join Date
    07-31-2010
    Location
    California
    MS-Off Ver
    Excel 2007
    Posts
    4,070

    Re: [help with code] need to update existing code to copy and keep rows on input page

    Both your code and your post are very confusing. I recommend that you submit an example workbook with before and after expectations.

    With that being said I have scaled down your code to what I think is a more manageable representation. Once you supply more information I can proceed forward.

    Sub Untested()
Dim ws As Worksheet:    Set ws = Sheets("2016 Rejects")
Dim d As Object:    Set d = CreateObject("Scripting.Dictionary")
Dim arr As Variant, k As Variant
Dim i As Long

Application.ScreenUpdating = False

arr = ws.Range("D2:D" & ws.Range("D" & Rows.Count).End(xlUp).Row)

For i = LBound(arr, 1) To UBound(arr, 1)
    d(arr(i, 1)) = 1
Next i

For Each k In d.Keys
    With ws
        .AutoFilterMode = False
        .Range("D1:D" & .Range("D" & Rows.Count).End(xlUp).Row).AutoFilter 1, CStr(k)
        If Evaluate("=ISREF'" & CStr(k) & "'!A1)") Then
            .Range("D2:D" & .Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets(CStr(k)).Range("A" & Rows.Count).End(3)(2)
        End If
        .AutoFilterMode = False
    End With
Next k

Application.ScreenUpdating = True

End Sub
    If you are happy with my response please click the * in the lower left of my post.
    Reply With QuoteRegister To Reply
+ Reply to Thread
« Previous Thread | Next Thread »

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. update existing code to copy and KEEP existing data
    By scott micklo in forum Excel Programming / VBA / Macros
    Replies: 20
    Last Post: 01-26-2016, 05:41 PM
  2. [SOLVED] Help with an existing VBA code to transfer data to 1st page then to overflow page 2.
    By ElmerFud in forum Excel Programming / VBA / Macros
    Replies: 10
    Last Post: 01-20-2016, 11:53 AM
  3. vba code to copy number of rows in based on the input message
    By prabhuduraraj09 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 10-12-2014, 12:38 AM
  4. code to display next page of multipage form based on answer to questions on existing page
    By Ishwarind in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 08-28-2014, 02:23 AM
  5. How to incorporate deleting duplicate code into existing copy to new sheet code when new v
    By Rizla21 in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 12-17-2013, 11:51 AM
  6. [SOLVED] VB Code help to change/update existing code
    By JDobbsy1987 in forum Excel Programming / VBA / Macros
    Replies: 13
    Last Post: 10-24-2013, 04:46 PM
  7. Putting Input box into existing code
    By jpthelpguy in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 01-23-2009, 02:14 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Forum Rules


Search Engine Friendly URLs by vBSEO 3.6.0 RC 1