Posts by dilshod_k

Quote from royUK

If you use ws.Move it will automatically move that sheet to a new workbook, which would simply need renaming.

Hi royUK,

Thanks for your help. The code moved two (out of 30) sheets to new books and gave Automation error at line#23. Apart from that all files with names Book # will have to be renamed manually, when I'll be processing hundreds of sheets it is going to be tedious. Is it possible to give file names the same as sheet names and close them automatically? Thanks again for your help.

Dilshod

Quote from Carim

Lines 12 to 20 in your macro ...

below is a tiny modification ... the instruction copying the worksheet comes before the instruction which saves the workbook ...

Hope this will help

Display More

Now it works perfectly well. Thanks a lot!

Appreciate your help.

Dilshod

Quote from Carim

Hello,

A quick fix could be the following :

Hello Carim,

Thanks very much for your help. It now does create xlsx files BUT, they still come up empty...

I've attached sample workbook with table, would you be able to make amendments to the code so that files would come with tables in them?

Thanks in advance for your help.

Dilshod

Sub CreateWorkbookFromSheets()

Dim ws As Worksheet
Dim wb As Workbook
Dim path As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

path = "C:\VBA\SMA4\Control Files SMA4\Files with orders"

For Each ws In ThisWorkbook.Worksheets
    If Not ws.Name Like "*T" And ws.Name <> "Sheet1" Then
        ws.Name = Replace(ws.Name, ".", "_")
        Set wb = Workbooks.Add
        wb.SaveAs path & "\" & ws.Name
        ws.Copy before:=wb.Worksheets(1)
        wb.Close savechanges = True
    End If
Next ws

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Hello everyone,

I've got sub that creates workbooks from sheets. My sheets have names in the form of dates in with format yyyy.mm.dd (2021.01.15 - for example).

Routine does creates files, but they come with names like 2021.01.20 without extensions (it should be 2021.01.20.xlsx) and can not be opened by Excel. When I try to rename them manually, they open with sheets empty, without any data. I would be grateful if you could help me to find out reason for that. Thanks in advance.

Dilshod

Sub CreateWorkbookFromSheets()

Dim ws As Worksheet
Dim wb As Workbook
Dim path As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

path = "C:\VBA\SMA4\Control Files SMA4\Files with orders"

For Each ws In ThisWorkbook.Worksheets
    If Not ws.Name Like "*T" And ws.Name <> "Sheet1" Then
        Set wb = Workbooks.Add
        wb.SaveAs path & "\" & ws.Name
        ws.Copy before:=wb.Worksheets(1)
        wb.Close savechanges = True
    End If
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Quote from Carim

Hello,

You will have to clarify your own process ... since coding with closed workbooks is not done in the same way as coding with opened workbooks ...

Hello,

Loop goes through multiple sheets of the file BacktestFile.xlsm and data copied to file Results.xlsm which is closed initially. I did not have problem with opening file Results.xlsm, problems started when I tried to add new sheets as it was giving error message that the sheet with that name already exists.

Thanks

Quote from royUK

Do you need the time as well as the date?

No, time is not essential, I wanted to assign name the same as source sheet name in yyyy.mm.dd format.

Quote from royUK

57 posts and you have cross posted this without letting us know. You have no excuse for not having read the rules by now!!

mrexcel.com forum does not support workbooks attachments, the thread there was not intended to solve the whole problem, I just posted request to give me suggestions regarding other ways to give new sheet name the same as source sheet name, without using shname = Ativesheet.name formula. Later on I realized that this post will be left unattended because people (and apparently I was right), without workbooks attached, would not be able to understand what I want, that is why I decided to cross publish to ozgrid.com, and I did not inform initially because initial content of these two posts were not identical.

The thread has been cross published at

https://www.mrexcel.com/board/…ame.1158648/#post-5620914

Quote from royUK

Using ThisWorkbook will mean the code will work on the workbook that contains the code.

ActiveWorkBook means the code will run on the currently active workbook.

I'm not really sure what you want to do, but I think your code will be very slow.

Hello royUK,

Thanks for your message.

I'm not professional in coding, I'm physician. I can't make it work, not to mention about thinking about speed of the code.

Half of the code works within BacktestFile.xlsm as it has to copy list of the stocks from original sheet with table, except Sheet1 (sheet name in yyyy.mm.dd format), paste it to Sheet1 of the same workbook, then download stock prices from internet, sort data in descending order, then copy it and paste transposed to a new sheet in Results.xlsm - (from here code works within Results.xlsm), then insert alternating empty columns between columns with data, calculate change in percentage, then calculate Average Totals. The name of the new sheet in Results.xlsm should be the same as the name of the original sheet in BacktestFile.xlsm.

Dilshod

Quote from Carim

Hello,

This topic has already been addressed many times in the Forum ...

You have to determine if you are working with closed workbooks ... or are your workbooks always opened ...

Hello Carim,

Only one workbook and it is closed, but might be open as well, it does not matter as long as code will be working.

Thanks

[xpost][/xpost]

Hello everyone,

I have Sub TestTable in the file BacktestFile.xlsm that processes data of the single (active) sheet at a time and copies results to the added new sheet with the (same name) + T. The aim is to make it automatically loop through all sheets (except Sheet1) in the file BacktestFile.xlsm and add new sheets with results to workbook Results.xlsm with names identical to names in the source file (BacktestFile.xlsm). The sub works well within the same workbook, but I could not make it transfer data to another workbook. I run across problem of assigning name to the new sheet, it would always give error message that the sheet with this name is already there. I would be grateful for any help in solving this problem. Please find attached BacktestFile.xlsm with Sub TestTable, and file Results.xlsm with results as they should look like after data processed automatically (I added sheets with results to file Results.xlsm manually), as an attachment to this post.

Thanks in advance.

Dilshod

Thank you very much!

Appreciate it.

Quote from KjBox

You're welcome. Thanks for the "Like"

Hello KjBox,

Sorry its me again. It gives error message (Type mismatch, Line#12 of the code) with another seemingly identical table.

Is there any chance you could help me to figure out reason for that error?

Please find attached file with Sheet2.

Thanks in advance,

Dilshod

Hi KjBox,

Thanks a lot for your help! It works perfectly well. Obviously I would not be able to sort it out on my own.

Highly appreciate it.

Dilshod

Quote from KjBox

What I meant by "manually created" was a table of data that was not in an Excel Built-in, the fact that code was used to make it makes no difference.

If, however you do not wish to use Excel Built-in Tables then this will remove any Total Averages that are already there and add new ones.

Hi KjBox,

Thanks very much for your help. Though there might be an error in your formula as there is quite a big discrepancy between manually calculated averages (if we assume formula is =AVERAGE(E2:E361)) Excel calculation for the column E gives 3.79% and result of your VBA code is 8.85%, the same is with the rest of the column results. Thanks for your time anyway.

Dilshod

Quote from KjBox

The simplest solution is to use an Excel Built-in Table with a Totals Row rather than a manually created table.

This table is not created manually, the code published is part of the code that copies and transposes data from one table to another one, to simplify explanation I decided to publish part of the code. I know how to calculate totals in Excel for a single column, but I do not know how to do that for multiple alternating columns.

Hello everyone,

I’ve code (thanks to Saurabhjaina211), that inserts blanc columns between columns with data and makes calculations. I still have to manually make calculations of the average value at the bottom of the columns with percentage values. I was wandering if it is possible to automatically calculate average percentage of the values of the alternating columns with data in percentage format. The number of rows as well as number of columns are flexible, alternating columns start from column E. Would be grateful for any help.

P.S. Please find sample of the table as an attachment to this post.

Dilshod

Sub TableResults()
'....

Dim colNo, colStart, colFinish, colStep As Long
Dim rng2Insert As Range

colStep = 2

colStart = Application.Cells(1, 4).Column + 1

colFinish = (ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column * 2) - colStart

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


    For colNo = colStart To colFinish Step colStep
        ActiveSheet.Cells(1, colNo).EntireColumn.Insert

        '***New code inserted
        ActiveSheet.Cells(1, colNo) = "Change%"
        ActiveSheet.Columns(colNo).NumberFormat = "0.00%"
        ActiveSheet.Cells(2, colNo) = "=(RC[-1]-RC[colNo-2])/RC[colNo-2]"
        ActiveSheet.Cells(2, colNo).Columns(colNo).AutoFill
        '***
    Next
   
'***New code inserted
        ActiveSheet.Cells(1, colNo) = "Change%"
        ActiveSheet.Columns(colNo).NumberFormat = "0.00%"
        '***

Dim colFinish2 As Integer, totalRows As Integer

colFinish2 = (ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column)

totalRows = WorksheetFunction.CountA(ActiveSheet.Range("B:B"))

On Error Resume Next

'Application.ScreenUpdating = False

    For colNo = 5 To colFinish Step 2

        With ActiveSheet

            For rowno = 2 To totalRows

            .Cells(rowno, colNo) = (.Cells(rowno, colNo - 1) - .Cells(rowno, 3)) / .Cells(rowno, 3)

            Next

        End With

    Next

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
Application.CutCopyMode = False

End Sub

Quote from saurabhjaina211

Hi,

Seems your date formats are not equal. In csv it's 11/6/2020 and in search cell it's 06-11-2020.

Thanks,

Saurabh

Display More

Hi Saurabh,

Thanks for your message.

Even when I tried to manually make sure that both date formats are the same (11/6/2020 14:30) it did not change anything, the code still was not working. The thread has been solved couple of minutes ago at http://www.excelforum.com

Thanks again for you feedback.

Dilshod

Hello everyone,

I've sub that loops through multiple csv files and searches date value in column B (dates in descending order 11/28/2020 14:30 format). Once the date is found aim is to check cell M value of the same row, if it is = "BUY", then to copy/paste data to another (this) workbook. The code is not working. No error messages. initially I thought that it does not copy data, later on I've realized that id does not find searched value. I've posted the same thread at another forum:

https://www.excelforum.com/exc…in-value.html#post5448122

but I was not able to upload attachments there and hence was not able to get help from coders. Tried to change search arguments from xlWhole to xlPart, from xlValues to xlFormulas with no success.

Please find code as it follows below along with attached file with code (MasterFilePriceAnalyser.xlsm) and sample csv file with data I'm looking for (ALRM.csv). File ALRM.cvs extesion had to be changed to .xls as .csv files cannot be uploaded. The code needs to be able to search in csv files. The code is supposed to find row39 and copy/paste range A:O to thisworkbook. I would be helpful for any help.

Sub SearchDate()

Dim wb As Workbook, ws As Worksheet
Dim sDate As Range
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldr = fso.GetFolder("C:\VBA\VBA\To be processed 1\")
Set DestSh = Workbooks("MasterFilePriceAnalyser.xlsm").Worksheets("MasterSheet")
Set destwb = Workbooks("MasterFilePriceAnalyser.xlsm")

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = True
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

With DestSh
        .Range("A1").Value = "Symbol"
        .Range("B1").Value = "Date"
        .Range("C1").Value = "Open"
        .Range("D1").Value = "High"
        .Range("E1").Value = "Low"
        .Range("F1").Value = "Close"
        .Range("G1").Value = "Adj. Close"
        .Range("H1").Value = "Volume"
        .Range("I1").Value = "V/SMA10"
        .Range("J1").Value = "Vol/Change%"
        .Range("K1").Value = "SMA10"
        .Range("L1").Value = "SMA30"
        .Range("M1").Value = "Buy/Sell"
        .Range("N1").Value = "Close/Change%"
End With
       ActiveSheet.Columns.AutoFit

 On Error Resume Next
 
Dim counter As Long
Dim numFiles As Long
numFiles = fldr.Files.Count
counter = 1

    For Each wbFile In fldr.Files
            Application.StatusBar = "Processing: " & Format(counter / numFiles, "0.0%") & " completed"
                If fso.GetExtensionName(wbFile.Name) = "csv" Then
               
                    Set wb = Workbooks.Open(wbFile.Path)
                                                
                    Set sDate = wb.worksheets(1).Range("B:B").Find(what:=destwb.Worksheets("Sheet1").Range("B1").Value, LookIn:=xlValues, lookat:=xlWhole)
                        If sDate <> "" Then
                            DestRowNumber = DestSh.Cells(Rows.Count, 1).End(xlUp).Row
                                If sDate.Offset(0, 11).Value = "BUY" Then
                                    DestSh.Rows(DestRowNumber).Range("A1:O1").Value = sDate.EntireRow.Range("A1:O1").Value
                                End If
                        Else
                        End If
                wb.Close True

                End If
    counter = counter + 1

    Next wbFile

DestSh.Columns.AutoFit

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.DisplayStatusBar = True

End Sub

Quote from saurabhjaina211

Hi Dilshod_k,

Add below code in the sheet:

Code

Sub calculateDiff()
Dim colFinish As Integer, colNo As Integer, totalRows As Integer
colFinish = (ActiveSheet.UsedRange.SpecialCells( _
xlCellTypeLastCell).Column)


totalRows = WorksheetFunction.CountA(ActiveSheet.Range("B:B"))


Application.ScreenUpdating = False


For colNo = 5 To colFinish Step 2
With ActiveSheet


For rowno = 2 To totalRows
.Cells(rowno, colNo) = (.Cells(rowno, colNo - 1) - .Cells(rowno, 3)) / .Cells(rowno, 3)
Next


End With
Next


Application.ScreenUpdating = True
End Sub

Display More

Thanks,

Saurabh

Display More

Hi Saurabh,

Your code works perfectly well. As sometimes price values might be "", I've just added On error resume next. My mistake was that I have not noticed that I've sent you table with single stock price values repeated multiple times, that is why it took me some time to figure out glitch in my code. Thanks a lot for your help! I would definitely not be able to figure out how to do that on my own. Highly appreciate it!