Append Data with Custom Hashtag, Automate with VBA & Button

[ThePianoman]

I'm looking for a bit of help for a pretty straightforward small project. I'm fairly familiar with all the basic functions of excel, VLOOKUP, pivot tables, etc., but clueless when it comes to VBA. I realize it can probably be done manually pretty easily, or using helper columns or similar, but I will need to perform the function several times and make it easy for other research study sites to use. So automated with VBA is the way I want to go. I'm willing to donate a small fee to whoever can work with me on this- you guys are the experts.

Here's a brief rundown:

• I will periodically export a dataset from a research study database, in excel format. It will look something like this (with exactly this many columns, but potentially many more rows of data):

	A	B	C	D	E	F	G	H
1	demo_mrn <tbody> </tbody>	ffi_shrinking_score <tbody> </tbody>	ffi_gripstrength_score <tbody> </tbody>	ffi_slowwalking_score <tbody> </tbody>	ffi_lowactivity_score <tbody> </tbody>	ffi_fr <tbody> </tbody>	cfs_cfsscore <tbody> </tbody>	rai_score_total <tbody> </tbody>
2	11111111	0	1	0	0	1	1	89
3	22222222	3	2	2	1	3	4	55
4	33333333	1	2	1	1	0	3	67
5	44444444	1	1	1	1	4	1	42
6	55555555	0	0	1	2	2	2	25
7	66666666	3	1	2	1	3	4	67
8	77777777	4	1	3	3	2	1	84
9	88888888	1	4	3	2	2	1	77

<tbody>
</tbody>

• The data (B2:H9) needs to have "#F4_[column header in row 1]_" appended to it so that it will look exactly like this:

	A	B	C	D	E	F	G	H
1	demo_mrn <tbody> </tbody>	ffi_shrinking_score <tbody> </tbody>	ffi_gripstrength_score <tbody> </tbody>	ffi_slowwalking_score <tbody> </tbody>	ffi_lowactivity_score <tbody> </tbody>	ffi_fr <tbody> </tbody>	cfs_cfsscore <tbody> </tbody>	rai_score_total <tbody> </tbody>
2	11111111	#F4_ffi_shrinking_score_0	#F4_ffi_gripstrength_score_1	#F4_ffi_slowwalking_score_0	#F4_ffi_lowactivity_score_0	#F4_ffi_fr_1	#F4_cfs_cfsscore_1	#F4_rai_score_total_89
3	22222222	#F4_ffi_shrinking_score_3	#F4_ffi_gripstrength_score_2	#F4_ffi_slowwalking_score_2	#F4_ffi_lowactivity_score_1	#F4_ffi_fr_3	#F4_cfs_cfsscore_4	#F4_rai_score_total_55
4	33333333	#F4_ffi_shrinking_score_1	#F4_ffi_gripstrength_score_2	#F4_ffi_slowwalking_score_1	#F4_ffi_lowactivity_score_1	#F4_ffi_fr_0	#F4_cfs_cfsscore_3	#F4_rai_score_total_67
5	44444444	#F4_ffi_shrinking_score_1	#F4_ffi_gripstrength_score_1	#F4_ffi_slowwalking_score_1	#F4_ffi_lowactivity_score_1	#F4_ffi_fr_4	#F4_cfs_cfsscore_1	#F4_rai_score_total_42
6	55555555	#F4_ffi_shrinking_score_0	#F4_ffi_gripstrength_score_0	#F4_ffi_slowwalking_score_1	#F4_ffi_lowactivity_score_2	#F4_ffi_fr_2	#F4_cfs_cfsscore_2	#F4_rai_score_total_25
7	66666666	#F4_ffi_shrinking_score_3	#F4_ffi_gripstrength_score_1	#F4_ffi_slowwalking_score_2	#F4_ffi_lowactivity_score_1	#F4_ffi_fr_3	#F4_cfs_cfsscore_4	#F4_rai_score_total_67
8	77777777	#F4_ffi_shrinking_score_4	#F4_ffi_gripstrength_score_1	#F4_ffi_slowwalking_score_3	#F4_ffi_lowactivity_score_3	#F4_ffi_fr_2	#F4_cfs_cfsscore_1	#F4_rai_score_total_84
9	88888888	#F4_ffi_shrinking_score_1	#F4_ffi_gripstrength_score_4	#F4_ffi_slowwalking_score_3	#F4_ffi_lowactivity_score_2	#F4_ffi_fr_2	#F4_cfs_cfsscore_1	#F4_rai_score_total_77

<tbody>
</tbody>

• The dataset could include up to 1500 rows. Preferably I would like the VBA function to be initiated with a button. So it would work like this:

1. Export the data to excel.
2. Copy/Paste data into the macro worksheet
3. Click the button to convert/append the data
4. Click another button to create a new workbook (regular excel file), and copy the converted data into it.

Thanks in advance for your help.

 

[Trevor_S]

I'm assuming that the number of columns is fixed. If so, your first macro is:

Sub AppendMacro()
With ActiveSheet
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Application.ScreenUpdating = False
For DataCol = 2 to 8
  For DataRow = 2 to LastRow
    .Cells(DataRow, DataCol).Value = "#F4_" & .Cells(1, DataCol).Value & "_" & .Cells(DataRow, DataCol).Value
  Next
Next
Application.ScreenUpdating = True
End With
End Sub

The macro file will be a .xlsm file. The following macro will save it as a .xlsx file with the same name:

Sub SaveXlsx()
fName = ActiveWorkbook.Path & "\" & Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & ".xlsx"
ActiveWorkbook.SaveAs(fName)
End Sub

 

[ThePianoman]

Thanks Trevor, this is great. I do get the following error:

"Run-time error '1004': This extension can not be used with the selected file type. Change the file extension in the File name text box or select a different file type by changing the Save as type"

I would actually prefer to have the worksheet copied to a new workbook, and the "save as" prompt to appear so I can choose location and name of the new file. Is that doable?

Thanks.

 

[Trevor_S]

Try this for the second macro:

Sub SaveXlsx()
Dim ThisWb As Workbook
Dim NewWb As Workbook
Set ThisWb = ActiveWorkbook
Set NewWb = Workbooks.New
ThisWb.ActiveSheet.Range("A:H").Copy
NewWb.ActiveSheet.Range("A:H").Select
Selection.Paste
fName = Application.GetSaveAsFilename(,"Excel Workbook (*.xlsx), *.xlsx")
If fName = "" then
  'User cancelled, do not save file
Else
  NewWb.SaveAs(fName)
End If
End Sub

 

[ThePianoman]

Thanks Trevor- I had to modify it just a bit, but it worked. Please pm me your Paypal email address. Thanks!

 

[Trevor_S]

Glad that it worked.
Its a free forum! I've learned a lot from it over the years, so I'm always happy to answer any threads that I can.

 

[ThePianoman]

Well thanks! I feel like I'm robbing you of your knowledge. I appreciate the help, I wish I knew a bit more VBA to to do this on my own.