+ Reply to Thread
Results 1 to 8 of 8

Please Help Me With This Code

  1. #1
    Sam Fowler
    Guest

    Please Help Me With This Code

    Hi:

    I posted this last night but I think I was unclear as to what I need to do.
    The code below (which was put together with the help of several forum
    members) performs a check on 10 different worksheets to determine if anything
    is in the first data entry cell of the last page. If not it goes to the next
    page (up). When data is found it copies all cells on that page and above to a
    primary spreadsheet. However, I am finding that I am spending a lot of time
    adjusting row heights. Can anyone help me get this to copy the entire row,
    rather than just the cells. I understand that would preserve the row heights
    and solve my problem.
    All sheets are same # columns and Rows.

    It also goes back to sheets and clears entered data.


    Sub Data_Ranges_Copy_and_Clear()

    Dim vCopySheets As Variant
    Dim vCheckPoints As Variant
    Dim vCopyRange As Variant
    Dim rng As Range
    Dim Rng2 As Range
    Dim Rng3 As Range

    Dim iCounter As Integer
    Dim iCounter2 As Integer


    vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", "OS Claim",
    "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold During")

    'Select each sheet in turn

    For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
    Sheets(vCopySheets(iCounter)).Select

    'Cells on this sheet to test
    vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", "A129", "A99",
    "A69", "A39", "A9")

    'Corresponding ranges to copy
    vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", "A1:P210",
    "A1:P180", "A1:P150", "A1:P120", "A1:P90", "A1:P60", "A1:P30")

    For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
    Set rng = Range(vCheckPoints(iCounter2))
    If Not (IsEmpty(rng)) Then
    'set copy area
    Set Rng2 = Range(vCopyRange(iCounter2))
    'Before copying find pasting point
    Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
    'Now copy to other sheet
    With Rng2
    .Copy Rng3
    ' .ClearContents

    End With

    'Items found and copied so get out of (inner)loop
    Exit For
    End If
    Next
    'Move on to next sheet
    Next

    ' Now Clear Data Ranges
    Dim ws As Worksheet, i As Long

    For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", "Fact
    Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold
    During"))

    For i = 0 To 9
    ws.Range("A1:L28").Offset(i * 30).ClearContents
    Next i
    Next
    Sheets("INV").Select

    End Sub


    Thanks Very much,
    --
    Sam Fowler

  2. #2
    Gary Keramidas
    Guest

    Re: Please Help Me With This Code

    hi sam:

    too elaborate for me to comment on. i know this simple code works to copy
    row1 from sheet 1 to the active row on sheet 2, but don't know how to apply
    it in your case
    i'm sure one of the experts will check in

    Sub copy_row()
    Worksheets("sheet1").Rows(1).Copy
    Worksheets("sheet2").Paste
    End Sub


    --


    Gary


    "Sam Fowler" <[email protected]> wrote in message
    news:[email protected]...
    > Hi:
    >
    > I posted this last night but I think I was unclear as to what I need to
    > do.
    > The code below (which was put together with the help of several forum
    > members) performs a check on 10 different worksheets to determine if
    > anything
    > is in the first data entry cell of the last page. If not it goes to the
    > next
    > page (up). When data is found it copies all cells on that page and above
    > to a
    > primary spreadsheet. However, I am finding that I am spending a lot of
    > time
    > adjusting row heights. Can anyone help me get this to copy the entire row,
    > rather than just the cells. I understand that would preserve the row
    > heights
    > and solve my problem.
    > All sheets are same # columns and Rows.
    >
    > It also goes back to sheets and clears entered data.
    >
    >
    > Sub Data_Ranges_Copy_and_Clear()
    >
    > Dim vCopySheets As Variant
    > Dim vCheckPoints As Variant
    > Dim vCopyRange As Variant
    > Dim rng As Range
    > Dim Rng2 As Range
    > Dim Rng3 As Range
    >
    > Dim iCounter As Integer
    > Dim iCounter2 As Integer
    >
    >
    > vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", "OS
    > Claim",
    > "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold During")
    >
    > 'Select each sheet in turn
    >
    > For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
    > Sheets(vCopySheets(iCounter)).Select
    >
    > 'Cells on this sheet to test
    > vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", "A129",
    > "A99",
    > "A69", "A39", "A9")
    >
    > 'Corresponding ranges to copy
    > vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", "A1:P210",
    > "A1:P180", "A1:P150", "A1:P120", "A1:P90", "A1:P60", "A1:P30")
    >
    > For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
    > Set rng = Range(vCheckPoints(iCounter2))
    > If Not (IsEmpty(rng)) Then
    > 'set copy area
    > Set Rng2 = Range(vCopyRange(iCounter2))
    > 'Before copying find pasting point
    > Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1,
    > 0)
    > 'Now copy to other sheet
    > With Rng2
    > .Copy Rng3
    > ' .ClearContents
    >
    > End With
    >
    > 'Items found and copied so get out of (inner)loop
    > Exit For
    > End If
    > Next
    > 'Move on to next sheet
    > Next
    >
    > ' Now Clear Data Ranges
    > Dim ws As Worksheet, i As Long
    >
    > For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", "Fact
    > Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold
    > During"))
    >
    > For i = 0 To 9
    > ws.Range("A1:L28").Offset(i * 30).ClearContents
    > Next i
    > Next
    > Sheets("INV").Select
    >
    > End Sub
    >
    >
    > Thanks Very much,
    > --
    > Sam Fowler




  3. #3
    Jim Cone
    Guest

    Re: Please Help Me With This Code

    Sam,

    Made some slight changes to the code.
    At the code line with the <<<<, I have added ".EntireRow" which
    should allow the copying of all rows in the copy range.
    The changes, I made are untested.

    Regards,
    Jim Cone
    San Francisco, USA

    '-----------------------------------------------
    Sub Data_Ranges_Copy_and_Clear()
    Dim vCopySheets As Variant
    Dim vCheckPoints As Variant
    Dim vCopyRange As Variant
    Dim rng As Range
    Dim Rng2 As Range
    Dim Rng3 As Range

    Dim iCounter As Integer
    Dim iCounter2 As Integer

    vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", _
    "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
    "Prepaid", "Sold During")
    'Select each sheet in turn
    For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
    Sheets(vCopySheets(iCounter)).Select
    'Cells on this sheet to test
    vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", _
    "A129", "A99", "A69", "A39", "A9")
    'Corresponding ranges to copy
    vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", _
    "A1:P210", "A1:P180", "A1:P150", "A1:P120", _
    "A1:P90", "A1:P60", "A1:P30")
    For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
    Set rng = Range(vCheckPoints(iCounter2))
    If Not (IsEmpty(rng)) Then
    'set copy area
    Set Rng2 = Range(vCopyRange(iCounter2)).EntireRow '<<<<
    'Before copying find pasting point
    Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
    'Now copy to other sheet
    Rng2.Copy Rng3
    'Items found and copied so get out of (inner)loop
    Exit For
    End If
    Next
    'Move on to next sheet
    Next

    'Now Clear Data Ranges
    Dim ws As Worksheet, i As Long

    For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", _
    "Fact Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
    "Prepaid", "Sold During "))
    For i = 0 To 9
    ws.Range("A1:L28").Offset(i * 30).ClearContents
    Next i
    Next
    Sheets("INV").Select

    Set rng = Nothing
    Set Rng2 = Nothing
    Set Rng3 = Nothing
    End Sub
    '----------------------------

    "Sam Fowler"
    <[email protected]>
    wrote in message
    news:[email protected]
    Hi:
    I posted this last night but I think I was unclear as to what I need to do.
    The code below (which was put together with the help of several forum
    members) performs a check on 10 different worksheets to determine if anything
    is in the first data entry cell of the last page. If not it goes to the next
    page (up). When data is found it copies all cells on that page and above to a
    primary spreadsheet. However, I am finding that I am spending a lot of time
    adjusting row heights. Can anyone help me get this to copy the entire row,
    rather than just the cells. I understand that would preserve the row heights
    and solve my problem.
    All sheets are same # columns and Rows.

    It also goes back to sheets and clears entered data.

    - snip -

  4. #4
    William Benson
    Guest

    Re: Please Help Me With This Code

    ..Copy Rng3.EntireRow


    "Sam Fowler" <[email protected]> wrote in message
    news:[email protected]...
    > Hi:
    >
    > I posted this last night but I think I was unclear as to what I need to
    > do.
    > The code below (which was put together with the help of several forum
    > members) performs a check on 10 different worksheets to determine if
    > anything
    > is in the first data entry cell of the last page. If not it goes to the
    > next
    > page (up). When data is found it copies all cells on that page and above
    > to a
    > primary spreadsheet. However, I am finding that I am spending a lot of
    > time
    > adjusting row heights. Can anyone help me get this to copy the entire row,
    > rather than just the cells. I understand that would preserve the row
    > heights
    > and solve my problem.
    > All sheets are same # columns and Rows.
    >
    > It also goes back to sheets and clears entered data.
    >
    >
    > Sub Data_Ranges_Copy_and_Clear()
    >
    > Dim vCopySheets As Variant
    > Dim vCheckPoints As Variant
    > Dim vCopyRange As Variant
    > Dim rng As Range
    > Dim Rng2 As Range
    > Dim Rng3 As Range
    >
    > Dim iCounter As Integer
    > Dim iCounter2 As Integer
    >
    >
    > vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", "OS
    > Claim",
    > "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold During")
    >
    > 'Select each sheet in turn
    >
    > For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
    > Sheets(vCopySheets(iCounter)).Select
    >
    > 'Cells on this sheet to test
    > vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", "A129",
    > "A99",
    > "A69", "A39", "A9")
    >
    > 'Corresponding ranges to copy
    > vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", "A1:P210",
    > "A1:P180", "A1:P150", "A1:P120", "A1:P90", "A1:P60", "A1:P30")
    >
    > For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
    > Set rng = Range(vCheckPoints(iCounter2))
    > If Not (IsEmpty(rng)) Then
    > 'set copy area
    > Set Rng2 = Range(vCopyRange(iCounter2))
    > 'Before copying find pasting point
    > Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1,
    > 0)
    > 'Now copy to other sheet
    > With Rng2
    > .Copy Rng3
    > ' .ClearContents
    >
    > End With
    >
    > 'Items found and copied so get out of (inner)loop
    > Exit For
    > End If
    > Next
    > 'Move on to next sheet
    > Next
    >
    > ' Now Clear Data Ranges
    > Dim ws As Worksheet, i As Long
    >
    > For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", "Fact
    > Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold
    > During"))
    >
    > For i = 0 To 9
    > ws.Range("A1:L28").Offset(i * 30).ClearContents
    > Next i
    > Next
    > Sheets("INV").Select
    >
    > End Sub
    >
    >
    > Thanks Very much,
    > --
    > Sam Fowler




  5. #5
    Sam Fowler
    Guest

    Re: Please Help Me With This Code

    Thanks for the help on this

    This did solve the row height problem. However I apparently have an
    additional problem that I wasn't aware of.

    The code is designed to check for data in the first entry cell on each page.
    (Sheets are comprised of 30 Rows..First 8 are for Header, Description, etc.,
    and the last 2 are for page totals and Grand Total. 9, 39, 69 etc.. are for
    additional Pages. I need this to look at the checkpoints, with A279 being the
    first entry cell on last Page. If Empty, go to page above and test, then
    repeat up to a9 (First Page). It is doing that as best I can tell. However,
    it is copying only those rows with data in column A. I need it to copy all 30
    Rows of any Page that has data entered in the A9, A39, etc. Columns. Can you
    give me any help on this?


    Thanks very much,
    Sam Fowler


    "Jim Cone" wrote:

    > Sam,
    >
    > Made some slight changes to the code.
    > At the code line with the <<<<, I have added ".EntireRow" which
    > should allow the copying of all rows in the copy range.
    > The changes, I made are untested.
    >
    > Regards,
    > Jim Cone
    > San Francisco, USA
    >
    > '-----------------------------------------------
    > Sub Data_Ranges_Copy_and_Clear()
    > Dim vCopySheets As Variant
    > Dim vCheckPoints As Variant
    > Dim vCopyRange As Variant
    > Dim rng As Range
    > Dim Rng2 As Range
    > Dim Rng3 As Range
    >
    > Dim iCounter As Integer
    > Dim iCounter2 As Integer
    >
    > vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", _
    > "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
    > "Prepaid", "Sold During")
    > 'Select each sheet in turn
    > For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
    > Sheets(vCopySheets(iCounter)).Select
    > 'Cells on this sheet to test
    > vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", _
    > "A129", "A99", "A69", "A39", "A9")
    > 'Corresponding ranges to copy
    > vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", _
    > "A1:P210", "A1:P180", "A1:P150", "A1:P120", _
    > "A1:P90", "A1:P60", "A1:P30")
    > For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
    > Set rng = Range(vCheckPoints(iCounter2))
    > If Not (IsEmpty(rng)) Then
    > 'set copy area
    > Set Rng2 = Range(vCopyRange(iCounter2)).EntireRow '<<<<
    > 'Before copying find pasting point
    > Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
    > 'Now copy to other sheet
    > Rng2.Copy Rng3
    > 'Items found and copied so get out of (inner)loop
    > Exit For
    > End If
    > Next
    > 'Move on to next sheet
    > Next
    >
    > 'Now Clear Data Ranges
    > Dim ws As Worksheet, i As Long
    >
    > For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", _
    > "Fact Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
    > "Prepaid", "Sold During "))
    > For i = 0 To 9
    > ws.Range("A1:L28").Offset(i * 30).ClearContents
    > Next i
    > Next
    > Sheets("INV").Select
    >
    > Set rng = Nothing
    > Set Rng2 = Nothing
    > Set Rng3 = Nothing
    > End Sub
    > '----------------------------
    >
    > "Sam Fowler"
    > <[email protected]>
    > wrote in message
    > news:[email protected]
    > Hi:
    > I posted this last night but I think I was unclear as to what I need to do.
    > The code below (which was put together with the help of several forum
    > members) performs a check on 10 different worksheets to determine if anything
    > is in the first data entry cell of the last page. If not it goes to the next
    > page (up). When data is found it copies all cells on that page and above to a
    > primary spreadsheet. However, I am finding that I am spending a lot of time
    > adjusting row heights. Can anyone help me get this to copy the entire row,
    > rather than just the cells. I understand that would preserve the row heights
    > and solve my problem.
    > All sheets are same # columns and Rows.
    >
    > It also goes back to sheets and clears entered data.
    >
    > - snip -
    >


  6. #6
    Sam Fowler
    Guest

    Re: Please Help Me With This Code

    William:

    Thanks for the help on this.

    I have posted a reply with an additional problem I am having with this code.
    Any help you might be able to offer would be appreciated very much

    Thanks
    --
    Sam Fowler


    "William Benson" wrote:

    > ..Copy Rng3.EntireRow
    >
    >
    > "Sam Fowler" <[email protected]> wrote in message
    > news:[email protected]...
    > > Hi:
    > >
    > > I posted this last night but I think I was unclear as to what I need to
    > > do.
    > > The code below (which was put together with the help of several forum
    > > members) performs a check on 10 different worksheets to determine if
    > > anything
    > > is in the first data entry cell of the last page. If not it goes to the
    > > next
    > > page (up). When data is found it copies all cells on that page and above
    > > to a
    > > primary spreadsheet. However, I am finding that I am spending a lot of
    > > time
    > > adjusting row heights. Can anyone help me get this to copy the entire row,
    > > rather than just the cells. I understand that would preserve the row
    > > heights
    > > and solve my problem.
    > > All sheets are same # columns and Rows.
    > >
    > > It also goes back to sheets and clears entered data.
    > >
    > >
    > > Sub Data_Ranges_Copy_and_Clear()
    > >
    > > Dim vCopySheets As Variant
    > > Dim vCheckPoints As Variant
    > > Dim vCopyRange As Variant
    > > Dim rng As Range
    > > Dim Rng2 As Range
    > > Dim Rng3 As Range
    > >
    > > Dim iCounter As Integer
    > > Dim iCounter2 As Integer
    > >
    > >
    > > vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", "OS
    > > Claim",
    > > "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold During")
    > >
    > > 'Select each sheet in turn
    > >
    > > For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
    > > Sheets(vCopySheets(iCounter)).Select
    > >
    > > 'Cells on this sheet to test
    > > vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", "A129",
    > > "A99",
    > > "A69", "A39", "A9")
    > >
    > > 'Corresponding ranges to copy
    > > vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", "A1:P210",
    > > "A1:P180", "A1:P150", "A1:P120", "A1:P90", "A1:P60", "A1:P30")
    > >
    > > For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
    > > Set rng = Range(vCheckPoints(iCounter2))
    > > If Not (IsEmpty(rng)) Then
    > > 'set copy area
    > > Set Rng2 = Range(vCopyRange(iCounter2))
    > > 'Before copying find pasting point
    > > Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1,
    > > 0)
    > > 'Now copy to other sheet
    > > With Rng2
    > > .Copy Rng3
    > > ' .ClearContents
    > >
    > > End With
    > >
    > > 'Items found and copied so get out of (inner)loop
    > > Exit For
    > > End If
    > > Next
    > > 'Move on to next sheet
    > > Next
    > >
    > > ' Now Clear Data Ranges
    > > Dim ws As Worksheet, i As Long
    > >
    > > For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", "Fact
    > > Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", "Prepaid", "Sold
    > > During"))
    > >
    > > For i = 0 To 9
    > > ws.Range("A1:L28").Offset(i * 30).ClearContents
    > > Next i
    > > Next
    > > Sheets("INV").Select
    > >
    > > End Sub
    > >
    > >
    > > Thanks Very much,
    > > --
    > > Sam Fowler

    >
    >
    >


  7. #7
    Jim Cone
    Guest

    Re: Please Help Me With This Code

    Sam,

    re: "it is copying only those rows with data in column A"

    The code works for me; the entire row is copied.
    You could try putting a stop at the "next" line (just before it loops
    to the next sheet). Then look at the INV sheet and see what was
    pasted.

    Regards,
    Jim Cone


    "Sam Fowler"
    <[email protected]>
    wrote in message
    news:[email protected]...
    Thanks for the help on this

    This did solve the row height problem. However I apparently have an
    additional problem that I wasn't aware of.
    The code is designed to check for data in the first entry cell on each page.
    (Sheets are comprised of 30 Rows..First 8 are for Header, Description, etc.,
    and the last 2 are for page totals and Grand Total. 9, 39, 69 etc.. are for
    additional Pages. I need this to look at the checkpoints, with A279 being the
    first entry cell on last Page. If Empty, go to page above and test, then
    repeat up to a9 (First Page). It is doing that as best I can tell. However,
    it is copying only those rows with data in column A. I need it to copy all 30
    Rows of any Page that has data entered in the A9, A39, etc. Columns. Can you
    give me any help on this?
    Thanks very much,
    Sam Fowler


    "Jim Cone" wrote:
    > Sam,
    > Made some slight changes to the code.
    > At the code line with the <<<<, I have added ".EntireRow" which
    > should allow the copying of all rows in the copy range.
    > The changes, I made are untested.
    >
    > Regards,
    > Jim Cone
    > San Francisco, USA
    >
    > '-----------------------------------------------
    > Sub Data_Ranges_Copy_and_Clear()
    > Dim vCopySheets As Variant
    > Dim vCheckPoints As Variant
    > Dim vCopyRange As Variant
    > Dim rng As Range
    > Dim Rng2 As Range
    > Dim Rng3 As Range
    >
    > Dim iCounter As Integer
    > Dim iCounter2 As Integer
    >
    > vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", _
    > "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
    > "Prepaid", "Sold During")
    > 'Select each sheet in turn
    > For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
    > Sheets(vCopySheets(iCounter)).Select
    > 'Cells on this sheet to test
    > vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", _
    > "A129", "A99", "A69", "A39", "A9")
    > 'Corresponding ranges to copy
    > vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", _
    > "A1:P210", "A1:P180", "A1:P150", "A1:P120", _
    > "A1:P90", "A1:P60", "A1:P30")
    > For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
    > Set rng = Range(vCheckPoints(iCounter2))
    > If Not (IsEmpty(rng)) Then
    > 'set copy area
    > Set Rng2 = Range(vCopyRange(iCounter2)).EntireRow '<<<<
    > 'Before copying find pasting point
    > Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
    > 'Now copy to other sheet
    > Rng2.Copy Rng3
    > 'Items found and copied so get out of (inner)loop
    > Exit For
    > End If
    > Next
    > 'Move on to next sheet
    > Next
    >
    > 'Now Clear Data Ranges
    > Dim ws As Worksheet, i As Long
    >
    > For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", _
    > "Fact Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
    > "Prepaid", "Sold During "))
    > For i = 0 To 9
    > ws.Range("A1:L28").Offset(i * 30).ClearContents
    > Next i
    > Next
    > Sheets("INV").Select
    >
    > Set rng = Nothing
    > Set Rng2 = Nothing
    > Set Rng3 = Nothing
    > End Sub
    > '----------------------------
    >
    > "Sam Fowler"
    > <[email protected]>
    > wrote in message
    > news:[email protected]
    > Hi:
    > I posted this last night but I think I was unclear as to what I need to do.
    > The code below (which was put together with the help of several forum
    > members) performs a check on 10 different worksheets to determine if anything
    > is in the first data entry cell of the last page. If not it goes to the next
    > page (up). When data is found it copies all cells on that page and above to a
    > primary spreadsheet. However, I am finding that I am spending a lot of time
    > adjusting row heights. Can anyone help me get this to copy the entire row,
    > rather than just the cells. I understand that would preserve the row heights
    > and solve my problem.
    > All sheets are same # columns and Rows.>
    > It also goes back to sheets and clears entered data.
    > - snip -



  8. #8
    Sam Fowler
    Guest

    Re: Please Help Me With This Code

    Jim:

    You are correct. It does work. I realized I had no Data in some of the cells
    in column A. By finding last cell and offsetting by one row, I was
    overwriting some of the data already copied.

    Thanks again
    --
    Sam Fowler


    "Jim Cone" wrote:

    > Sam,
    >
    > re: "it is copying only those rows with data in column A"
    >
    > The code works for me; the entire row is copied.
    > You could try putting a stop at the "next" line (just before it loops
    > to the next sheet). Then look at the INV sheet and see what was
    > pasted.
    >
    > Regards,
    > Jim Cone
    >
    >
    > "Sam Fowler"
    > <[email protected]>
    > wrote in message
    > news:[email protected]...
    > Thanks for the help on this
    >
    > This did solve the row height problem. However I apparently have an
    > additional problem that I wasn't aware of.
    > The code is designed to check for data in the first entry cell on each page.
    > (Sheets are comprised of 30 Rows..First 8 are for Header, Description, etc.,
    > and the last 2 are for page totals and Grand Total. 9, 39, 69 etc.. are for
    > additional Pages. I need this to look at the checkpoints, with A279 being the
    > first entry cell on last Page. If Empty, go to page above and test, then
    > repeat up to a9 (First Page). It is doing that as best I can tell. However,
    > it is copying only those rows with data in column A. I need it to copy all 30
    > Rows of any Page that has data entered in the A9, A39, etc. Columns. Can you
    > give me any help on this?
    > Thanks very much,
    > Sam Fowler
    >
    >
    > "Jim Cone" wrote:
    > > Sam,
    > > Made some slight changes to the code.
    > > At the code line with the <<<<, I have added ".EntireRow" which
    > > should allow the copying of all rows in the copy range.
    > > The changes, I made are untested.
    > >
    > > Regards,
    > > Jim Cone
    > > San Francisco, USA
    > >
    > > '-----------------------------------------------
    > > Sub Data_Ranges_Copy_and_Clear()
    > > Dim vCopySheets As Variant
    > > Dim vCheckPoints As Variant
    > > Dim vCopyRange As Variant
    > > Dim rng As Range
    > > Dim Rng2 As Range
    > > Dim Rng3 As Range
    > >
    > > Dim iCounter As Integer
    > > Dim iCounter2 As Integer
    > >
    > > vCopySheets = Array("Cores", "NPN", "Est", "GOG", "Fact Claim", _
    > > "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
    > > "Prepaid", "Sold During")
    > > 'Select each sheet in turn
    > > For iCounter = LBound(vCopySheets) To UBound(vCopySheets) Step 1
    > > Sheets(vCopySheets(iCounter)).Select
    > > 'Cells on this sheet to test
    > > vCheckPoints = Array("A279", "A249", "A219", "A189", "A159", _
    > > "A129", "A99", "A69", "A39", "A9")
    > > 'Corresponding ranges to copy
    > > vCopyRange = Array("A1:P300", "A1:P270", "A1:P240", _
    > > "A1:P210", "A1:P180", "A1:P150", "A1:P120", _
    > > "A1:P90", "A1:P60", "A1:P30")
    > > For iCounter2 = LBound(vCheckPoints) To UBound(vCheckPoints) Step 1
    > > Set rng = Range(vCheckPoints(iCounter2))
    > > If Not (IsEmpty(rng)) Then
    > > 'set copy area
    > > Set Rng2 = Range(vCopyRange(iCounter2)).EntireRow '<<<<
    > > 'Before copying find pasting point
    > > Set Rng3 = Sheets("INV").Cells(65536, 1).End(xlUp).Offset(1, 0)
    > > 'Now copy to other sheet
    > > Rng2.Copy Rng3
    > > 'Items found and copied so get out of (inner)loop
    > > Exit For
    > > End If
    > > Next
    > > 'Move on to next sheet
    > > Next
    > >
    > > 'Now Clear Data Ranges
    > > Dim ws As Worksheet, i As Long
    > >
    > > For Each ws In Worksheets(Array("Cores", "NPN", "Est", "GOG", _
    > > "Fact Claim", "OS Claim", "Fact PS", "OS PS", "INV-NOT-REC", _
    > > "Prepaid", "Sold During "))
    > > For i = 0 To 9
    > > ws.Range("A1:L28").Offset(i * 30).ClearContents
    > > Next i
    > > Next
    > > Sheets("INV").Select
    > >
    > > Set rng = Nothing
    > > Set Rng2 = Nothing
    > > Set Rng3 = Nothing
    > > End Sub
    > > '----------------------------
    > >
    > > "Sam Fowler"
    > > <[email protected]>
    > > wrote in message
    > > news:[email protected]
    > > Hi:
    > > I posted this last night but I think I was unclear as to what I need to do.
    > > The code below (which was put together with the help of several forum
    > > members) performs a check on 10 different worksheets to determine if anything
    > > is in the first data entry cell of the last page. If not it goes to the next
    > > page (up). When data is found it copies all cells on that page and above to a
    > > primary spreadsheet. However, I am finding that I am spending a lot of time
    > > adjusting row heights. Can anyone help me get this to copy the entire row,
    > > rather than just the cells. I understand that would preserve the row heights
    > > and solve my problem.
    > > All sheets are same # columns and Rows.>
    > > It also goes back to sheets and clears entered data.
    > > - snip -

    >
    >


+ Reply to Thread

Thread Information

Users Browsing this Thread

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

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1