Formula values using vba as per the data

[Chefsohail]

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.

 

[Chefsohail]

Test.xlsx

drive.google.com

 

[Chefsohail]

@mumps @Tupe77

Not sure if you got sometime to look at this.

Please help if you can...

 

[Chefsohail]

Hi team,

Anyone if you can please help.

 

[Tupe77]

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]

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())

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]

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]

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

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]

I tried adding this and it worked...but i dont know if its the right way to do it.

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]

I realized this is incorrect...it returns the value of E2 in the entire E row.

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