Macro for Submit/Print that will copy data from form into a history log and reset form

**bfille** · 02-28-2013, 02:03 AM

Hello. I am well versed with excel, but new to VBA/Macros. My situation seems to be unique, but aren't they all? Please don't link me to another 'how-to' site or someone's blog/video. I have been researching various forms and Excel tutorial websites for a few days now and have come across a few bits and pieces of what I am looking for, but have been unsuccessful in attempts to paste it all together. I am running short on time to get the project complete and am hoping that someone out there can help!

I have a worksheet (Estimate Input) that is basically a form - there are several cells that the user would input data into. I have a second worksheet (Estimate Log) which I want to house each individual form entry in a new line. I am looking for a macro/code that will automate this process when the user clicks on a [Submit] button; at the same time the button is clicked, I want the macro/code to save a copy of that worksheet 'as-is' in a new workbook and save it in a specified folder using the data in a specific cell to name it then to clear the form data. Furthermore, I want a macro/code that will automatically print this worksheet when the user clicks on a [Print] button.

I have several projects going on right now that I could use this same process with once I saw an example and could better understand how it works. I have been successful in setting up the process in reverse (taking data from a database and populating a form using Vlookups and Pivot tables) but that is not what I need in this case. I thank you profusely in advance for any help that is given. I have additional possibly relevant information below.

Cells in worksheet [Estimate Input] to be copied to worksheet [Estimate Log] in order that they would be copied:
I2,B8,B9,B10,B11,E7,J40,A15,B15,A16,B16,A17,B17,A18,B18,A19,B19,A20,B20,A21,B21,A22,B22,A23,B23,A24,B24,A25,B25,A26,B26,A27,B27,A28,B28,A29,B29,A30,B30,A31,B31,A32,B32,A33,B33,A34,B34,A35,B35,A36,B36,A37,B37,A38,B38,A39,B39

In Worksheet [Estimate Log], the first cell to have the copied data would be B6. (Column A is set to autogenerate when data is entered into Column B). I want each new submission to save in [Estimate Log] as a new row.

Some of the cells being copied from [Estimate Input] to [Estimate Log] are formulas in nature; however I only want the values to copy over, not the formulas.

Thanks again!
Britt

**JBeaucaire** · 02-28-2013, 08:17 AM

This should get you there, or most of the way:

Option Explicit

Sub SaveAndLogForm()
Dim fPATH As String, NR As Long

fPATH = "C:\Path\To\Save\"              'remember the final \ in this string

Application.ScreenUpdating = False      'turn off screen flicker, speed up macro
ActiveSheet.Copy                        'copies the form to a new workbook
ActiveWorkbook.SaveAs fPATH & Range("A1").Value & ".xlsx", 51       'save the workbook
ActiveWorkbook.Close False              'close the new workbook

With Sheets("Estimate Log")
    NR = .Range("B" & .Rows.Count).End(xlUp).Row + 1        'next empty row
    .Range("B" & NR).Value = Range("I2").Value              'map to transfer values
    .Range("C" & NR).Value = Range("B8").Value
    .Range("D" & NR).Value = Range("B9").Value
    .Range("E" & NR).Value = Range("B10").Value
    .Range("F" & NR).Value = Range("B11").Value
    .Range("G" & NR).Value = Range("E7").Value
    .Range("H" & NR).Value = Range("J40").Value
    .Range("I" & NR).Value = Range("A15").Value
    .Range("J" & NR).Value = Range("B15").Value
    .Range("K" & NR).Value = Range("A16").Value
    .Range("L" & NR).Value = Range("B16").Value
    .Range("M" & NR).Value = Range("B17").Value
    .Range("N" & NR).Value = Range("A18").Value
    .Range("O" & NR).Value = Range("B18").Value
    .Range("P" & NR).Value = Range("A19").Value
    .Range("Q" & NR).Value = Range("B19").Value
    .Range("R" & NR).Value = Range("A20").Value
    .Range("S" & NR).Value = Range("B20").Value
    .Range("T" & NR).Value = Range("A21").Value
    .Range("U" & NR).Value = Range("B21").Value
    .Range("V" & NR).Value = Range("A22").Value
    .Range("W" & NR).Value = Range("B22").Value
    .Range("X" & NR).Value = Range("A23").Value
    .Range("Y" & NR).Value = Range("B23").Value
    .Range("Z" & NR).Value = Range("A24").Value
    .Range("AA" & NR).Value = Range("B24").Value
    .Range("AB" & NR).Value = Range("A25").Value
    .Range("AC" & NR).Value = Range("B25").Value
    .Range("AD" & NR).Value = Range("A26").Value
    .Range("AE" & NR).Value = Range("B26").Value
    .Range("AF" & NR).Value = Range("A27").Value
    .Range("AG" & NR).Value = Range("B27").Value
    .Range("AH" & NR).Value = Range("A28").Value
    .Range("AI" & NR).Value = Range("B28").Value
    .Range("AJ" & NR).Value = Range("A29").Value
    .Range("AK" & NR).Value = Range("B29").Value
    .Range("AL" & NR).Value = Range("A30").Value
    .Range("AM" & NR).Value = Range("B30").Value
    .Range("AN" & NR).Value = Range("A31").Value
    .Range("AO" & NR).Value = Range("B31").Value
    .Range("AP" & NR).Value = Range("A32").Value
    .Range("AQ" & NR).Value = Range("B32").Value
    .Range("AR" & NR).Value = Range("A33").Value
    .Range("AS" & NR).Value = Range("B33").Value
    .Range("AT" & NR).Value = Range("A34").Value
    .Range("AU" & NR).Value = Range("B34").Value
    .Range("AV" & NR).Value = Range("A35").Value
    .Range("AW" & NR).Value = Range("B35").Value
    .Range("AX" & NR).Value = Range("A36").Value
    .Range("AY" & NR).Value = Range("B36").Value
    .Range("AZ" & NR).Value = Range("A37").Value
    .Range("BA" & NR).Value = Range("B37").Value
    .Range("BB" & NR).Value = Range("A38").Value
    .Range("BC" & NR).Value = Range("B38").Value
    .Range("BD" & NR).Value = Range("A39").Value
    .Range("BE" & NR).Value = Range("B39").Value
End With
                                                        'clear cells
Range("I2,B8,B9,B10,B11,E7,J40,A15,B15,A16,B16,A17,B17,A18,B18,A19,B19,A20,B20,A21,B21,A22,B22,A23,B23,A24,B24,A25,B25,A26,B26,A27,B27,A28,B28,A29,B29,A30,B30,A31,B31,A32,B32,A33,B33,A34,B34,A35,B35,A36,B36,A37,B37,A38,B38,A39,B39").ClearContents
Application.ScreenUpdating = True                       'screen back to normal
End Sub