Formula values using vba as per the data

Chefsohail

Board Regular
Joined
Oct 3, 2020
Messages
77
Office Version
  1. 365
Platform
  1. Windows
Hi Team, (@mumps @Tupe77 )

Need your expertise in here.

I have a workbook here which has 3 sheets.

1. first sheet named DS tracker has all the formulae i need in the cells.
2. 2nd sheet is the data sheet where i will add the data.
3. 3rd sheet is the lookup sheet where i will add data as required.

Here I will add a button in the Data Sheet, so that the team member can add the required data and then run the macro.
1. The macro should copy and paste all the values of the formulae in DS tracker sheet as per the data available in Data Sheet. For Row I and Row K, I want the formulae itself to appear and not the value as the users will need it whilst working.

2. The macro should -
a) open a new workbook.
b) copy the DS Tracker sheet from the macro workbook and paste the entire worksheet 'DS tracker' in the new workbook.
c) Create a new folder with todays date .. (If the folder is already created then continue saving the file in it)
d) Save this new workbook as 'DS_Tracker_Today's Date' as a .xlsx in the folder created above and keep it activated. (If a file is already saved with a name then add a continue saving it without overrite and give it a new name 'DS_Tracker_Today's Date (2)' or 'DS_Tracker_Today's Date (3)' or 'DS_Tracker_Today's Date (4)' as the case may be.
e) it should now close the above macro workbook without saving it.

Hope that helps.

Please let me know if you need any other information.
 
Last edited:

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

Tupe77

Board Regular
Joined
Nov 26, 2020
Messages
97
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Hi, I was traveling for Easter and I didn’t bring a computer with me.
This week myself is in a hurry, but I will try to watch that as soon as I have time.

I would think I understand macro 2, but macro 1 probably needs a more detailed description.
 

Tupe77

Board Regular
Joined
Nov 26, 2020
Messages
97
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Macro 2 (Sub TS_Crete_New_Workbook())
I think this fulfill the functions of Macro 2. (Another thing is do it work as intended?)
Date format is year.month.day for sorting files and folder by name "Date" -part of name. (can be changed if necessary)
The folder "C: \ workbooks \" to which the folders created from the date will come must be made manually! (can be changed if necessary)
The automatic shutdown of the workbook is disabled to speed up testing.
Error handling only restores the program settings and terminates ALL vba code!

Nevermind about this if Macro 1 works like it should...
Do the headings on the DATA sheet match the letters in the columns on the DS Tracker sheet?
So Data sheet column F with header L is copied with it's values to DS Tracker sheet L column?
Columns i & k are copied with their formulas?
Can columns be copied with their headings?

I made somekind version about macro 1, does it work the way you mean it?
Macro 1 (Sub TS_Copy_Columns())

VBA Code:
Sub TS_Crete_New_Workbook()

On Error GoTo ErrHand
Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False

Dim wb As Workbook, wbNew As Workbook
Set wb = ThisWorkbook: Set wbNew = Workbooks.Add

Dim PathBase As String, PathDate As String, BaseFileName As String, FreeFileName As String, FormDate As String
Dim i As Integer

' This reverse Date format for file system sorting purpose
FormDate = Format(Date, Format:="yyyy.mm.dd")

' Variables for path and file names
PathBase = "C:\workbooks\" ' Create this folder "C:\workbooks\" or change "C:\workbooks\" to exist folder
PathDate = FormDate & "\"
BaseFileName = "DS_Tracker_" & FormDate

' Check Date folder exist "C:\workbooks\" MUST CREATE MANUALLY!!!!!!
    If Dir(PathBase & PathDate, vbDirectory) = vbNullString Then
        VBA.FileSystem.MkDir (PathBase & PathDate)
    Else
        'MsgBox "Folder exists."
    End If

'Find non used FileName
For i = 1 To 50
    'check for existence of proposed filename
    If Dir(PathBase & PathDate & BaseFileName & "_(" & Format(i, "00") & ")" & ".xlsx") = vbNullString Then
        FreeFileName = BaseFileName & "_(" & Format(i, "00") & ")" & ".xlsx"
        Exit For
    End If
Next i

'Copy Sheet and remove default sheet
wb.Sheets("DS Tracker").Copy Before:=wbNew.Sheets(1)
wbNew.Sheets(2).Delete

'Save New Workbook
wbNew.SaveAs Filename:=PathBase & PathDate & FreeFileName
wbNew.Activate

' Closes the workbook from which the macro was run. This has been commented out, for testing.
'Application.Wait (Now + TimeValue("0:00:3"))
'wb.Close SaveChanges:=False

ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End
End Sub



Sub TS_Copy_Columns()
On Error GoTo ErrHand
Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False

Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsDS As Worksheet, wsData As Worksheet: Set wsDS = wb.Worksheets("DS Tracker"): Set wsData = wb.Worksheets("Data")

' Copy columns
wsData.Range(wsData.UsedRange.Columns("A").Address).Copy wsDS.Columns("A")
wsData.Range(wsData.UsedRange.Columns("B").Address).Copy wsDS.Columns("C")
wsData.Range(wsData.UsedRange.Columns("C").Address).Copy wsDS.Columns("G")
wsData.Range(wsData.UsedRange.Columns("D").Address).Copy wsDS.Columns("H")
wsData.Range(wsData.UsedRange.Columns("E").Address).Copy wsDS.Columns("J")
wsData.Range(wsData.UsedRange.Columns("F").Address).Copy wsDS.Columns("L")
wsData.Range(wsData.UsedRange.Columns("G").Address).Copy wsDS.Columns("M")
wsData.Range(wsData.UsedRange.Columns("H").Address).Copy wsDS.Columns("N")

' Filldown formulas
wsDS.Range("B2").Formula = "=LEFT(A2,8)": wsDS.Range("B2:B" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("D2").Formula = "=RIGHT(C2,5)": wsDS.Range("D2:D" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("E2").Formula = "=VLOOKUP(D2,'UOM Comm'!D:R,2,0)": wsDS.Range("E2:E" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("F2").Formula = "=VLOOKUP(D2,'UOM Comm'!D:R,7,0)": wsDS.Range("F2:F" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("i2").Formula = "=LEN(H2)": wsDS.Range("i2:i" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("k2").Formula = "=LEN(J2)": wsDS.Range("k2:k" & wsDS.UsedRange.Rows.Count).FillDown

ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End
End Sub
 

Chefsohail

Board Regular
Joined
Oct 3, 2020
Messages
77
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Thanx @Tupe77 .

I'll check and let you know.

With macro 1.

I have already copied all the formulae required in the cell in DS tracker sheet.

To answer your questions -

Do the headings on the DATA sheet match the letters in the columns on the DS Tracker sheet? The columns match however may not be in the right order.
Eg: header A in both the sheets will be same
Likewise all the headers in Data sheet will be in DS tracker sheet... I'm ok if you want to copy paste the entire column.. Hope that answers the question.

So Data sheet column F with header L is copied with it's values to DS Tracker sheet L column? Yes.

Columns i & k are copied with their formulas? Yes. And I need the formulae still in there after the macro is executed. The formulae in header 'I' has reference to column H... So any changes done after the execution of macro needs to get updated as per the formulae.

columns be copied with their headings?
That's fine... We will keep the header in DS tracker sheet as is.

I made somekind version about macro 1, does it work the way you mean it?
I'll check and confirm
 

Chefsohail

Board Regular
Joined
Oct 3, 2020
Messages
77
Office Version
  1. 365
Platform
  1. Windows
Hey @Tupe77,

Thanks for your help. Apologies it took me a while to test it.. was on leaves due to a sudden medical condition. I have made a few modifications as per my requirement. PFB

VBA Code:
Sub TS_Copy_Columns()
On Error GoTo ErrHand
Application.Calculation = xlManual: Application.ScreenUpdating = False: Application.DisplayAlerts = False

Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsDS As Worksheet, wsData As Worksheet: Set wsDS = wb.Worksheets("DS Tracker"): Set wsData = wb.Worksheets("Data")

' Copy columns
wsData.Range(wsData.UsedRange.Columns("A").Address).Copy wsDS.Columns("A")
wsData.Range(wsData.UsedRange.Columns("B").Address).Copy wsDS.Columns("C")
wsData.Range(wsData.UsedRange.Columns("C").Address).Copy wsDS.Columns("G")
wsData.Range(wsData.UsedRange.Columns("D").Address).Copy wsDS.Columns("H")
wsData.Range(wsData.UsedRange.Columns("E").Address).Copy wsDS.Columns("J")
wsData.Range(wsData.UsedRange.Columns("F").Address).Copy wsDS.Columns("L")
wsData.Range(wsData.UsedRange.Columns("G").Address).Copy wsDS.Columns("M")
wsData.Range(wsData.UsedRange.Columns("H").Address).Copy wsDS.Columns("N")
wsData.Range(wsData.UsedRange.Columns("I").Address).Copy wsDS.Columns("Q")
wsDS.Range("Q2:Q" & wsDS.UsedRange.Rows.Count).FillDown

' Filldown formulas
wsDS.Range("B2").Formula = "=LEFT(A2,8)": wsDS.Range("B2:B" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("D2").Formula = "=RIGHT(C2,5)": wsDS.Range("D2:D" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("E2").Formula = "=VLOOKUP(D2,'UOM Comm'!D:R,2,0)": wsDS.Range("E2:E" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("F2").Formula = "=VLOOKUP(D2,'UOM Comm'!D:R,7,0)": wsDS.Range("F2:F" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("i2").Formula = "=LEN(H2)": wsDS.Range("i2:i" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("k2").Formula = "=LEN(J2)": wsDS.Range("k2:k" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("P2").Value = Format(Date, Format:="mm/dd/yy"): wsDS.Range("P2:P" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("R2").Formula = "=IF(M2="""",""Failure"", IF(LEFT(J2,1)=CHAR(41),""Na"",""Auto Approve""))": wsDS.Range("R2:R" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("O2").Value = "Description New Task": wsDS.Range("O2:O" & wsDS.UsedRange.Rows.Count).FillDown


ErrHand:
Application.Calculation = xlAutomatic: Application.ScreenUpdating = True: Application.DisplayAlerts = True
If Err.Number <> 0 Then MsgBox "Something went badly wrong!" & vbCrLf & "VBA-code is ended!" & vbCrLf & vbCrLf & "Error number: " & Err.Number & " " & Err.Description: End
End Sub


I need help to convert certain formulae to Values...I dont need the formula to appear in the cell.

for all, except these 2 -

wsDS.Range("i2").Formula = "=LEN(H2)": wsDS.Range("i2:i" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("k2").Formula = "=LEN(J2)": wsDS.Range("k2:k" & wsDS.UsedRange.Rows.Count).FillDown

Once done with this, i will test the second code and confirm the solution.

Thanks
 

Chefsohail

Board Regular
Joined
Oct 3, 2020
Messages
77
Office Version
  1. 365
Platform
  1. Windows
I tried adding this and it worked...but i dont know if its the right way to do it.

VBA Code:
wsDS.Range("E2").Formula = "=VLOOKUP(D2,'UOM Comm'!D:R,2,0)": wsDS.Range("E2:E" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("E2:E" & wsDS.UsedRange.Rows.Count).Value = wsDS.Range("E2:E" & wsDS.UsedRange.Rows.Count).Value
 

Chefsohail

Board Regular
Joined
Oct 3, 2020
Messages
77
Office Version
  1. 365
Platform
  1. Windows
I realized this is incorrect...it returns the value of E2 in the entire E row.

VBA Code:
wsDS.Range("E2").Formula = "=VLOOKUP(D2,'UOM Comm'!D:R,2,0)": wsDS.Range("E2:E" & wsDS.UsedRange.Rows.Count).FillDown
wsDS.Range("E2:E" & wsDS.UsedRange.Rows.Count).Value = wsDS.Range("E2:E" & wsDS.UsedRange.Rows.Count).Value
 

Watch MrExcel Video

Forum statistics

Threads
1,129,592
Messages
5,637,291
Members
416,963
Latest member
zazama

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top