Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 387
  • Last Modified:

Excel - VBA to Ask for a Date input and copy that to Cells that have data in another column

Hello experts.

I am exporting a bunch of month end data info out of a program that will dump into excel. Trouble is the export won't append the data to the end of one sheet.  It puts the info on a separate sheet for each month.  So to get a master data sheet I am cutting and pasting the info onto one sheet in the workbook I titled "Historical".  

When the program exports it automatically names the new sheet "Sheet "X"" where "X" is the next number sheet.  When it exports there is no column that shows what month end the data is for So, what I do is starting at J3 I key a month end date and copy that all the way down to the last row of data and then I cut and paste the info off of "Sheet 1" onto my "Historical" sheet.  Then I delete "Sheet 1" so that the next time I export it will use "Sheet 1" as the name again when exporting.

Is there a way I can create a macro to do all that?
0
wlwebb
Asked:
wlwebb
  • 12
  • 6
  • 5
1 Solution
 
Farzad AkbarnejadCommented:
Hello,
Instead of writing code for your macro you can record macro. It creates codes for you automatically.
From " Tools > Macro > Record New Macro .... " menu you can activate it. The You can do a complete scenario of your task then stop recording. Test your new macro from next starting point of your job.

-FA
0
 
wlwebbAuthor Commented:
Problem is with the recorded macro is two things.  

A) The recorded macro wants to copy the new info starting at the cell where the macro was originally recorded instead of the starting at the next row after the last used row.  Thus it overwrites the last info copied and

B) When recording the macro I hard key a month end date the recorded macro uses that hard keyed date on the next execution so I would need an input box to get the "date" that I want copied on the Sheet 1 before moving that data over to my "Historical" master sheet.
0
 
wlwebbAuthor Commented:
This is the code the recorded macro "wrote"  The problems I think will be relative references and code to stop and ask for a date input

Sub ExportData()
'
' ExportData Macro
' Keyboard Shortcut: Ctrl+a
'
    Sheets("Sheet1").Select
    Range("J3").Select
    ActiveCell.FormulaR1C1 = "9/30/2009"
    Range("J3").Select
    Selection.Copy
    Selection.End(xlDown).Select
    Range("I65536").Select
    Selection.End(xlUp).Select
    Range("J380").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.End(xlUp).Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Rows("3:3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    ActiveSheet.Next.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Range("A9944").Select
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Range("A10322").Select
    ActiveSheet.Previous.Select
    Sheets("Sheet1").Select
    ActiveWindow.SelectedSheets.Delete
    ActiveWorkbook.Save
End Sub

Open in new window

0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Farzad AkbarnejadCommented:
Hello,
When recording new macro press relative reference button in the appeared toolbar (it contains two button, Stop and Relative button). I think that It solves your first problem.
For input data you can use the following code:

ActiveCell.FormulaR1C1 = InputBox("Prompt", "Title")

-FA
0
 
wlwebbAuthor Commented:
I am working off the clients system and all they have is Excel 2003.  I do not see a "Relative" button when creating the new macro.
0
 
Farzad AkbarnejadCommented:
I am using Excel 2003 too. Its Toolbar name is "Stop Recording" .
You can Right Click on toolbar and tick show it.

-FA
0
 
Saqib Husain, SyedEngineerCommented:
Try this macro and come back if you have a problem
Sub AppendData()
Set wb = ThisWorkbook
Set sws = twb.Sheets("Sheet1")
Set tws = twb.Sheets("Mastersheet") '<----------Change this to suit
Set ur = sws.UsedRange
tws.Activate
Range(ur.Address).Select
lr = tws.Range("A" & tws.Rows.Count).End(xlUp).Row + 1
nr = ur.Rows.Count
tws.Range(Cells(lr, 10).Address & ":" & Cells(lr + nr - 1, 10).Address) = "Month"                    '<-------These two cells can contain
tws.Range(Cells(lr, 11).Address & ":" & Cells(lr + nr - 1, 11).Address) = "Anyother reference"       '<-------your month references or anything else
ur.Copy tws.Range(Cells(lr, 1).Address)
Next ws
sws.Delete
End Sub

Open in new window

0
 
wlwebbAuthor Commented:
Doesn't work.  Still overwrites prior data. I showed the "Stop Recording" and the "Relative Reference" was checkmarked.
0
 
Saqib Husain, SyedEngineerCommented:
Can you upload a sample file with dummy data?
0
 
Farzad AkbarnejadCommented:
would you please paste your new recorded macro with relative references.

-FA
0
 
wlwebbAuthor Commented:
ssaqibh:

I get an error on:
Next ws
0
 
wlwebbAuthor Commented:
FarzadA:

This is the new macro with "Relative References" checked

Sub QBExportDataNEW()
'
' QBExportDataNEW Macro
' Keyboard Shortcut: Ctrl+z

    Sheets("Sheet1").Select
    Range("J3").Select
    ActiveCell.FormulaR1C1 = InputBox("Prompt", "Title")
    Range("J3").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    Selection.End(xlDown).Select
    Range("I65536").Select
    Selection.End(xlUp).Select
    Range("J422").Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
    Application.CutCopyMode = False
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Rows("3:3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    ActiveSheet.Next.Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Range("A12305").Select
    ActiveSheet.Paste
    Selection.End(xlDown).Select
    Range("A12725").Select
    Sheets("Sheet1").Select
    ActiveWindow.SelectedSheets.Delete
    
    

End Sub

Open in new window

0
 
Saqib Husain, SyedEngineerCommented:
Just delete that line

Next ws
0
 
Farzad AkbarnejadCommented:
Hello,
You must record new macro. Before starting new macro you must check Relative Reference button. It causes you have offset keyword in your selections range code.

-FA
 
0
 
wlwebbAuthor Commented:
Here is a sample data worksheet.
Testing.xls
0
 
wlwebbAuthor Commented:
FarzadA:
"Hello,
You must record new macro. Before starting new macro you must check Relative Reference button. It causes you have offset keyword in your selections range code."


It is checked and it was checked.  That is what I got again.

Just re recorded it for the 3rd time.  Still get the same.
0
 
wlwebbAuthor Commented:
ssaqibh:
remarked that line out.  Now I error out on the second line of code

Set sws = twb.Sheets("Sheet1")
0
 
Saqib Husain, SyedEngineerCommented:
Sub AppendData()
Set twb = ThisWorkbook
Set sws = twb.Sheets("Sheet 1")
Set tws = twb.Sheets("Historical") '<----------Change this to suit
Set ur = sws.UsedRange
sws.Activate
sws.Range(ur.Address).Select
lr = tws.Range("J" & tws.Rows.Count).End(xlUp).Row + 1
nr = ur.Rows.Count
tws.Range(Cells(lr, 10).Address & ":" & Cells(lr + nr - 1, 10).Address) = InputBox("Enter month")
tws.Range(Cells(lr, 11).Address & ":" & Cells(lr + nr - 1, 11).Address) = "Anyother reference"       '<-------your month references or anything else
ur.Copy tws.Range(Cells(lr, 1).Address)
sws.Delete
End Sub

0
 
wlwebbAuthor Commented:
ssaqibh
Thank you for your help.  Thanks also to the others who attempted but never could get their solutions to work.
0
 
wlwebbAuthor Commented:
ssaqibh
Just one comment Rows 1 & 2 of the Sheet1 data are headers and it copies those two lines over to the "Historical" master sheet which I just delete.  Also, when it copies the InputBox date that I key in it is copying that to one more line than the end of the data.  I just delete that also.  Otherwise works perfectly.

Again, Many thanks.
0
 
Saqib Husain, SyedEngineerCommented:
I have adjusted the macro for the top two lines. The sample provided does not add an additional month cell at the bottom.

Saqib
Sub AppendData()
Set twb = ThisWorkbook
Set sws = twb.Sheets("Sheet 1")
Set tws = twb.Sheets("Historical") '<----------Change this to suit
Set ur = sws.UsedRange
sws.Activate
lr = tws.Range("J" & tws.Rows.Count).End(xlUp).Row + 1
nr = ur.Rows.Count - 2
tws.Range(Cells(lr, 10).Address & ":" & Cells(lr + nr - 1, 10).Address) = InputBox("Enter month")
tws.Range(Cells(lr, 11).Address & ":" & Cells(lr + nr - 1, 11).Address) = "Anyother reference"       '<-------your month references or anything else
ur.Offset(2, 0).Copy tws.Range(Cells(lr, 1).Address)
sws.Delete
End Sub

Open in new window

0
 
Saqib Husain, SyedEngineerCommented:
This assumes that is exactly two rows at the top which have to be ignored
0
 
wlwebbAuthor Commented:
ssaqibh:

Adjusted the macro as suggested.  Works PERFECT.  In this case the Offset(2 takes care of the headers.  The export function of the program I working with does in fact always export with 2 lines of header.

Thanks!!!
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 12
  • 6
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now