Another 'Copy To The Next Available Row' Question

J

Joe

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.live.com/self.aspx/.Public/csw^_dashboard^_TEST.xlsm
 
J

JLatham

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
 
J

Joe

JLatham,

That did the trick! I am truly thankful to you for helping with this.

Joe

Sub SaveData()
'
' SaveData Macro
' Saves information from Dashboard to Data
'

Source_Date = "D6"
Source_State = "H6"
Source_Inquiry_Type = "D8"
Source_Member_ID = "H8"
Source_Inquirer_Last_Name = "D10"
Source_Inquirer_First_Name = "H10"
Source_Contact_Name = "L10"
Source_Reference_Type = "D14"
Source_Reference_ID = "H14"
Source_Reference_Last_Name = "D16"
Source_Reference_First_Name = "H16"
Source_Telephone = "D18"
Source_Reason = "H18"
Source_Comments = "D22:L23"
Source_Comments2 = "D25:L26"
Destination_Date = "A"
Destination_State = "B"
Destination_Inquiry_Type = "C"
Destination_Member_ID = "D"
Destination_Inquirer_Last_Name = "E"
Destination_Inquirer_First_Name = "F"
Destination_Contact_Name = "G"
Destination_Reference_Type = "H"
Destination_Reference_ID = "I"
Destination_Reference_Last_Name = "J"
Destination_Reference_First_Name = "K"
Destination_Telephone = "L"
Destination_Reason = "M"
Destination_Comments = "N"
Destination_Comments2 = "O"

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
nextRow = Worksheets("Data").Range(Destination_Member_ID _
& Rows.Count).End(xlUp).Row + 1
Application.ScreenUpdating = False

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

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

How to copy and paste a partial row (i.e. not the EntireRow) 5
Copy to next blank row 5
Copy & Paste from one Worksheet to another without giving focus? 1
Copy conditional format from one sheet to another using VBA 0
Copy worksheet from one workbook to another 3
Select a row, copy and repeat on the next row 0
VB code to copy sheet format to another sheet 12
delete the copy of row to another worksheet when date is deleted 1

Top