Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
|
|||
|
|||
![]()
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).ClearCo ntents InputRange = Source_State NextCol = Destination_State Worksheets("Dashboard").Range(Source_State).Copy Destination:=Worksheets("Data").Range(NextCol & nextRow) Worksheets("Dashboard").Range(Source_State).ClearC ontents 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).Co py Destination:=Worksheets("Data").Range(NextCol & nextRow) Worksheets("Dashboard").Range(Source_Member_ID).Cl earContents 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_Firs t_Name).Copy Destination:=Worksheets("Data").Range(NextCol & nextRow) Worksheets("Dashboard").Range(Source_Inquirer_Firs t_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 |
#2
![]()
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
|
|||
|
|||
![]()
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_Membe r_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).ClearCon tents InputRange = Source_State NextCol = Destination_State Worksheets("Data").Range(NextCol & nextRow) = _ Worksheets("Dashboard").Range(InputRange) Worksheets("Dashboard").Range(InputRange).ClearCon tents InputRange = Source_Inquiry_Type NextCol = Destination_Inquiry_Type Worksheets("Data").Range(NextCol & nextRow) = _ Worksheets("Dashboard").Range(InputRange) Worksheets("Dashboard").Range(InputRange).ClearCon tents InputRange = Source_Member_ID NextCol = Destination_Member_ID Worksheets("Data").Range(NextCol & nextRow) = _ Worksheets("Dashboard").Range(InputRange) Worksheets("Dashboard").Range(InputRange).ClearCon tents InputRange = Source_Inquirer_Last_Name NextCol = Destination_Inquirer_Last_Name Worksheets("Data").Range(NextCol & nextRow) = - Worksheets("Dashboard").Range(InputRange) Worksheets("Dashboard").Range(InputRange).ClearCon tents InputRange = Source_Inquirer_First_Name NextCol = Destination_Inquirer_First_Name Worksheets("Data").Range(NextCol & nextRow) =_ Worksheets("Dashboard").Range(InputRange) Worksheets("Dashboard").Range(InputRange).ClearCon tents ' 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).ClearCo ntents InputRange = Source_State NextCol = Destination_State Worksheets("Dashboard").Range(Source_State).Copy Destination:=Worksheets("Data").Range(NextCol & nextRow) Worksheets("Dashboard").Range(Source_State).ClearC ontents 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).Co py Destination:=Worksheets("Data").Range(NextCol & nextRow) Worksheets("Dashboard").Range(Source_Member_ID).Cl earContents 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_Firs t_Name).Copy Destination:=Worksheets("Data").Range(NextCol & nextRow) Worksheets("Dashboard").Range(Source_Inquirer_Firs t_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 |
#3
![]()
Posted to microsoft.public.excel.misc,microsoft.public.excel.programming
|
|||
|
|||
![]()
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_Membe r_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).ClearCon tents InputRange = Source_State NextCol = Destination_State Worksheets("Data").Range(NextCol & nextRow) = _ Worksheets("Dashboard").Range(InputRange) Worksheets("Dashboard").Range(InputRange).ClearCon tents InputRange = Source_Inquiry_Type NextCol = Destination_Inquiry_Type Worksheets("Data").Range(NextCol & nextRow) = _ Worksheets("Dashboard").Range(InputRange) Worksheets("Dashboard").Range(InputRange).ClearCon tents InputRange = Source_Member_ID NextCol = Destination_Member_ID Worksheets("Data").Range(NextCol & nextRow) = _ Worksheets("Dashboard").Range(InputRange) Worksheets("Dashboard").Range(InputRange).ClearCon tents InputRange = Source_Inquirer_Last_Name NextCol = Destination_Inquirer_Last_Name Worksheets("Data").Range(NextCol & nextRow) = _ Worksheets("Dashboard").Range(InputRange) Worksheets("Dashboard").Range(InputRange).ClearCon tents InputRange = Source_Inquirer_First_Name NextCol = Destination_Inquirer_First_Name Worksheets("Data").Range(NextCol & nextRow) = _ Worksheets("Dashboard").Range(InputRange) Worksheets("Dashboard").Range(InputRange).ClearCon tents End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Another 'Copy To The Next Available Row' Question | Excel Discussion (Misc queries) | |||
Can a checkbox be placed 'within a row'? | Excel Programming | |||
Another 'IF cell contains THEN color row' Question | Excel Discussion (Misc queries) | |||
Possible to trap an 'Insert Row' via VBA ? | Excel Programming | |||
How to get the 'current row' from VBA | Excel Programming |