Results 1 to 4 of 4

Thread: Coding (2000)

  1. #1
    4 Star Lounger
    Join Date
    May 2003
    Location
    Manchester, Gtr Manchester, England
    Posts
    552
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Coding (2000)

    User enters data into series of cells on 1 sheet and on button-click. I need this data to be transposed to another row on another worksheet. Then I need to repeat this with the transposed information going on the row below. This is the code I've done so far on button-click but it's not working out - always transposing data to first row.

    Private Sub cmdClear_Click()
    Dim lngNewRow As Long

    'Figure out the last row in the range
    Sheets("HR Summary").Activate
    Sheets("HR Summary").Range("A5").Select

    Do Until ActiveCell.Value = ""
    lngNewRow = lngNewRow + 1
    ActiveCell.Offset(1, 0).Select
    Loop

    ' Don't do anything if the data is not filled
    If IsNull(Worksheets("Salary Exchange Calculator").Range("B5").Value) Then
    Exit Sub
    End If

    ' One column at the time, append the data to the list
    Worksheets("HR Summary").Cells(lngNewRow + 5, 1).Value = Worksheets("Salary Exchange Calculator").Range("B5").Value ' Name
    Worksheets("HR Summary").Cells(lngNewRow + 5, 2).Value = Worksheets("Salary Exchange Calculator").Range("B6").Value ' DOB
    Worksheets("HR Summary").Cells(lngNewRow + 5, 3).Value = Worksheets("Salary Exchange Calculator").Range("B7").Value ' Gross Annual Salary
    Worksheets("HR Summary").Cells(lngNewRow + 5, 4).Value = Worksheets("Salary Exchange Summary").Range("B20").Value ' Gross Monthly Employer Contribution
    Worksheets("HR Summary").Cells(lngNewRow + 5, 5).Value = Worksheets("Salary Exchange Summary").Range("B13").Value ' Net monthly employee contribution
    Worksheets("HR Summary").Cells(lngNewRow + 5, 6).Value = Worksheets("Salary Exchange Summary").Range("F9").Value ' Gross Annual Salary after exchange
    Worksheets("HR Summary").Cells(lngNewRow + 5, 7).Value = Worksheets("Salary Exchange Summary").Range("C20").Value ' Total gross monthly employer contribtion after exchange

    'Clear the original input
    Worksheets("Salary Exchange Calculator").Range("B5").ClearContents
    Worksheets("Salary Exchange Calculator").Range("B6").ClearContents
    Worksheets("Salary Exchange Calculator").Range("B7").ClearContents
    Worksheets("Salary Exchange Calculator").Range("B10").ClearContents
    Worksheets("Salary Exchange Calculator").Range("B11").ClearContents

    ' Back to the calculator
    Sheets("Salary Exchange Calculator").Activate
    Sheets("Salary Exchange Calculator").Range("B5").Select

    End Sub

    Any ideas?

    Thanks

    Darren

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Coding (2000)

    I don't see why it shouldn't work, but I'd replace the code

    Sheets("HR Summary").Activate
    Sheets("HR Summary").Range("A5").Select

    Do Until ActiveCell.Value = ""
    lngNewRow = lngNewRow + 1
    ActiveCell.Offset(1, 0).Select
    Loop

    with the much simpler

    lngNewRow = Sheets("HR Summary").Range("A65536").End(xlUp).Row + 1

    and use

    Worksheets("HR Summary").Cells(lngNewRow, 1).Value = ...

    etc. (i.e. lngNewRow instead of lngNewRow + 5)

  3. #3
    Uranium Lounger
    Join Date
    Jan 2001
    Location
    South Carolina, USA
    Posts
    7,295
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Coding (2000)

    Try this:

    <code>
    Private Sub cmdClear_Click()
    Dim lngNewRow As Long

    'Figure out the last row in the range
    lngNewRow = Sheets("HR Summary").Range("A65536").End(xlUp).Row + 1
    If lngNewRow < 6 Then lngNewRow = 6

    ' Don't do anything if the data is not filled
    If IsNull(Worksheets("Salary Exchange Calculator").Range("B5").Value) Then
    Exit Sub
    End If

    ' One column at the time, append the data to the list
    Worksheets("HR Summary").Cells(lngNewRow, 1).Value = Worksheets("Salary Exchange Calculator").Range("B5").Value ' Name
    Worksheets("HR Summary").Cells(lngNewRow, 2).Value = Worksheets("Salary Exchange Calculator").Range("B6").Value ' DOB
    Worksheets("HR Summary").Cells(lngNewRow, 3).Value = Worksheets("Salary Exchange Calculator").Range("B7").Value ' Gross Annual Salary
    Worksheets("HR Summary").Cells(lngNewRow, 4).Value = Worksheets("Salary Exchange Summary").Range("B20").Value ' Gross Monthly Employer Contribution
    Worksheets("HR Summary").Cells(lngNewRow, 5).Value = Worksheets("Salary Exchange Summary").Range("B13").Value ' Net monthly employee contribution
    Worksheets("HR Summary").Cells(lngNewRow, 6).Value = Worksheets("Salary Exchange Summary").Range("F9").Value ' Gross Annual Salary after exchange
    Worksheets("HR Summary").Cells(lngNewRow, 7).Value = Worksheets("Salary Exchange Summary").Range("C20").Value ' Total gross monthly employer contribtion after exchange

    'Clear the original input
    Worksheets("Salary Exchange Calculator").Range("B5").ClearContents
    Worksheets("Salary Exchange Calculator").Range("B6").ClearContents
    Worksheets("Salary Exchange Calculator").Range("B7").ClearContents
    Worksheets("Salary Exchange Calculator").Range("B10").ClearContents
    Worksheets("Salary Exchange Calculator").Range("B11").ClearContents

    ' Back to the calculator
    Sheets("Salary Exchange Calculator").Activate
    Sheets("Salary Exchange Calculator").Range("B5").Select

    End Sub
    </code>
    Legare Coleman

  4. #4
    4 Star Lounger
    Join Date
    May 2003
    Location
    Manchester, Gtr Manchester, England
    Posts
    552
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Coding (2000)

    Thanks. These have been very helpful

Posting Permissions

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