Joe,
I think this would actually work but your workbook and code as now set up is
not allowing it to. You're testing for "lastrow" using column O on the Data
sheet, but your code isn't saving Comment1 just yet, so that column remains
empty, and so lastrow is always returning 1 (making nextRow always 2). So
row 2 is constantly overwritten.
I took the liberty of making some changes to your code to make it work now,
and add a few comments and a couple of code snippets to perhaps give you
ideas on how to improve it. There's no reason to go through the .Copy
Destination:= process, it's quicker to just use the copy method I have in the
code below. I split some of the code across multiple lines so that hopefully
you can simply copy and paste. If you see any red after copying it, probably
means the stuff on the next row in the code module needs to be part of the
statement above it.
You could make a copy of your workbook, and replace the SaveData sub in it
with this just to check things out.
Sub SaveMyData()
'
' SaveData Macro
' Saves information from Dashboard to Data
'
Source_Date = "D6" ' date
Source_State = "H6" ' state
Source_Inquiry_Type = "D8" ' inquiry type
Source_Member_ID = "H8" ' member id
Source_Inquirer_Last_Name = "D10" ' inq last name
Source_Inquirer_First_Name = "H10" ' inq first name
Source_Contact_Name = "L10" ' name of person talking to
Source_Reference_Type = "D14" ' ref type
Source_Reference_ID = "H14" ' ref id
Source_Reference_Last_Name = "D16" ' ref last name
Source_Reference_First_Name = "H16" ' ref first name
Source_Telephone = "D18" ' callback phone number
Source_Reason = "H18" ' reason for the call
Source_Comments = "D22:L23" ' comments block one
Source_Comments2 = "D25:L26" ' comments block two
Destination_Date = "A" ' date
Destination_State = "B" ' state
Destination_Inquiry_Type = "C" ' inquiry type
Destination_Member_ID = "D" ' member id
Destination_Inquirer_Last_Name = "E" ' inq last name
Destination_Inquirer_First_Name = "F" ' inq first name
Destination_Contact_Name = "G" ' name of person talking to
Destination_Reference_Type = "H" ' ref type
Destination_Reference_ID = "I" ' ref id
Destination_Reference_Last_Name = "J" ' ref last name
Destination_Reference_First_Name = "K" ' ref first name
Destination_Telephone = "L" ' callback phone number
Destination_Reason = "M" ' reason for the call
Destination_Comments = "N" ' comments block one
Destination_Comments2 = "O" ' comments block two
'first test/validate the inputs
'this is a simple one-cell test to see if there is
'an entry in our required area so that we will have
'something to put on a new row on the "Data" sheet
If IsEmpty(Worksheets("Dashboard").Range(Source_Member_ID)) Then
MsgBox "Missing Required Entry: Source Member ID", _
vbOKOnly, "Cannot Save Data"
Exit Sub
End If
Dim nextRow As Long
'you MUST reference a column that will ALWAYS have an
'entry made in it on the "Dashboard" sheet for all of
'this to work properly and not overwrite other data.
'changed to use Destination_Member_ID as that column
nextRow = Worksheets("Data").Range(Destination_Member_ID _
& Rows.Count).End(xlUp).Row + 1
'to make this all happen quickly
Application.ScreenUpdating = False
' two comments blocks due to 255 character per cell limit
InputRange = Source_Date
NextCol = Destination_Date
Worksheets("Data").Range(NextCol & nextRow) = _
Worksheets("Dashboard").Range(InputRange)
Worksheets("Dashboard").Range(InputRange).ClearContents
InputRange = Source_State
NextCol = Destination_State
Worksheets("Data").Range(NextCol & nextRow) = _
Worksheets("Dashboard").Range(InputRange)
Worksheets("Dashboard").Range(InputRange).ClearContents
InputRange = Source_Inquiry_Type
NextCol = Destination_Inquiry_Type
Worksheets("Data").Range(NextCol & nextRow) = _
Worksheets("Dashboard").Range(InputRange)
Worksheets("Dashboard").Range(InputRange).ClearContents
InputRange = Source_Member_ID
NextCol = Destination_Member_ID
Worksheets("Data").Range(NextCol & nextRow) = _
Worksheets("Dashboard").Range(InputRange)
Worksheets("Dashboard").Range(InputRange).ClearContents
InputRange = Source_Inquirer_Last_Name
NextCol = Destination_Inquirer_Last_Name
Worksheets("Data").Range(NextCol & nextRow) = -
Worksheets("Dashboard").Range(InputRange)
Worksheets("Dashboard").Range(InputRange).ClearContents
InputRange = Source_Inquirer_First_Name
NextCol = Destination_Inquirer_First_Name
Worksheets("Data").Range(NextCol & nextRow) =_
Worksheets("Dashboard").Range(InputRange)
Worksheets("Dashboard").Range(InputRange).ClearContents
' there are several more lines after this
' this is all I am test for now
End Sub
"Joe" wrote:
> I have an Excel 2007 spread sheet where I enter information on one sheet, and
> the ‘data’ is stored on a second sheet in the same workbook. The transfer of
> data works fine except - in subsequent posts of data, it does not move to the
> next available row. It is posting over the first row (after the heading)
> every time.
>
> I have read and tryed several of the recommendations posted here, and can
> not get them to work.
>
> I know I am close, but it does not work. Please show me what I am doing
> wrong in getting this to work correctly.
>
> Below, I am posting the VBA code as well as a link to the XLSM file.
>
> Thank you!
>
> Joe
>
> Sub SaveMyData()
> '
> ' SaveData Macro
> ' Saves information from Dashboard to Data
> '
>
> Dim lastrow As Long
> lastrow = Worksheets("Data").Range("O1048576").End(xlUp).Row
> nextRow = lastrow + 1
>
> Source_Date = "D6" ' date
> Source_State = "H6" ' state
> Source_Inquiry_Type = "D8" ' inquiry type
> Source_Member_ID = "H8" ' member id
> Source_Inquirer_Last_Name = "D10" ' inq last name
> Source_Inquirer_First_Name = "H10" ' inq first name
> Source_Contact_Name = "L10" ' name of person talking to
> Source_Reference_Type = "D14" ' ref type
> Source_Reference_ID = "H14" ' ref id
> Source_Reference_Last_Name = "D16" ' ref last name
> Source_Reference_First_Name = "H16" ' ref first name
> Source_Telephone = "D18" ' callback phone number
> Source_Reason = "H18" ' reason for the call
> Source_Comments = "D22:L23" ' comments block one
> Source_Comments2 = "D25:L26" ' comments block two
>
> Destination_Date = "A" ' date
> Destination_State = "B" ' state
> Destination_Inquiry_Type = "C" ' inquiry type
> Destination_Member_ID = "D" ' member id
> Destination_Inquirer_Last_Name = "E" ' inq last name
> Destination_Inquirer_First_Name = "F" ' inq first name
> Destination_Contact_Name = "G" ' name of person talking to
> Destination_Reference_Type = "H" ' ref type
> Destination_Reference_ID = "I" ' ref id
> Destination_Reference_Last_Name = "J" ' ref last name
> Destination_Reference_First_Name = "K" ' ref first name
> Destination_Telephone = "L" ' callback phone number
> Destination_Reason = "M" ' reason for the call
> Destination_Comments = "N" ' comments block one
> Destination_Comments2 = "O" ' comments block two
>
> ' two comment blocks due to 255 character per cell limit
>
> InputRange = Source_Date
> NextCol = Destination_Date
> Worksheets("Dashboard").Range(Source_Date).Copy
> Destination:=Worksheets("Data").Range(NextCol & nextRow)
> Worksheets("Dashboard").Range(Source_Date).ClearContents
>
> InputRange = Source_State
> NextCol = Destination_State
> Worksheets("Dashboard").Range(Source_State).Copy
> Destination:=Worksheets("Data").Range(NextCol & nextRow)
> Worksheets("Dashboard").Range(Source_State).ClearContents
>
> InputRange = Source_Inquiry_Type
> NextCol = Destination_Inquiry_Type
> Worksheets("Dashboard").Range(Source_Inquiry_Type).Copy
> Destination:=Worksheets("Data").Range(NextCol & nextRow)
> Worksheets("Dashboard").Range(Source_Inquiry_Type).ClearContents
>
> InputRange = Source_Member_ID
> NextCol = Destination_Member_ID
> Worksheets("Dashboard").Range(Source_Member_ID).Copy
> Destination:=Worksheets("Data").Range(NextCol & nextRow)
> Worksheets("Dashboard").Range(Source_Member_ID).ClearContents
>
> InputRange = Source_Inquirer_Last_Name
> NextCol = Destination_Inquirer_Last_Name
> Worksheets("Dashboard").Range(Source_Inquirer_Last_Name).Copy
> Destination:=Worksheets("Data").Range(NextCol & nextRow)
> Worksheets("Dashboard").Range(Source_Inquirer_Last_Name).ClearContents
>
> InputRange = Source_Inquirer_First_Name
> NextCol = Destination_Inquirer_First_Name
> Worksheets("Dashboard").Range(Source_Inquirer_First_Name).Copy
> Destination:=Worksheets("Data").Range(NextCol & nextRow)
> Worksheets("Dashboard").Range(Source_Inquirer_First_Name).ClearContents
>
> ' there are several more lines after this
> ' this is all I am test for now
>
> End Sub
>
> A link to the file...
> http://cid-1cc773911dea3ea1.skydrive...d%5E_TEST.xlsm
>
Similar Threads
