Posts by akin

akin · Jul 5th 2021

I need assistance of experts in the house on how to copy source workbook names along with other data in files I am to merge in new worksheet. The code will create a new column in the new worksheet and will fill it with the source book name (preferably first column)

I have this code that merge files based on number of rows already but with no demarcation on where one ends and another begins:

Code

Sub CopyRange()
Const SHEET_PREFIX As String = "Rows "
Dim wbDest As Workbook, wbSource As Workbook
Dim wsDest As Worksheet
Dim FolderName As String, Filename As String
Dim lastSource As Long, lastDest As Long
Dim startrow As Long
Dim starttime As Double


starttime = Timer


Application.ScreenUpdating = False


Set wbDest = ThisWorkbook
Set wsDest = wbDest.Worksheets(1)


With Application.FileDialog(msoFileDialogFolderPicker)


.AllowMultiSelect = False
.Show
FolderName = .SelectedItems(1) & ""
End With


Filename = Dir(FolderName & Application.PathSeparator & "*.xls*")
Do While Filename <> vbNullString


If Filename <> wbDest.Name Then


Set wbSource = Workbooks.Open(FolderName & Application.PathSeparator & Filename)
With wbSource


With .Worksheets(1)


lastSource = .Cells(.Rows.Count, "A").End(xlUp).Row
If Not SheetExists(SHEET_PREFIX & lastSource - 1) Then


Set wsDest = wbDest.Worksheets.Add(after:=wbDest.Worksheets(wbDest.Worksheets.Count))
wsDest.Name = SHEET_PREFIX & lastSource - 1


startrow = 1
lastDest = 0
Else


lastSource = lastSource - 1 'don't duplicate header
Set wsDest = ThisWorkbook.Worksheets(SHEET_PREFIX & lastSource)
lastDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row


startrow = 2
End If


.Rows(startrow).Resize(lastSource).Copy wsDest.Cells(lastDest + 1, "A")
End With


.Close False
End With
End If


Filename = Dir
Loop


MsgBox "All done in " & Format(Timer - starttime, "0.000") & " secs"


Application.ScreenUpdating = True
End Sub


Private Function SheetExists(ByVal SheetName As String) As Boolean
Dim ws As Worksheet


On Error Resume Next
Set ws = ThisWorkbook.Worksheets(SheetName)


SheetExists = Not ws Is Nothing
End Function

Display More

I have sample files for testrun too.

Thanks

akin · Jun 28th 2021

Please house, this problem has not been sold. It has not make me to move on my work. Your quick reply is highly needed. Thanks.

akin · Jun 26th 2021

Already, I have this VBA script that merge workbooks

Display Spoiler

akin · Jun 26th 2021

Hello house. I need urgent help on how to group some workbooks containing one worksheet each with similar data in them but varied rows of data.

The groupping becomes necessary because I want to run a macro script on them which is row sensitivity and has been giving conflicting results.

Please, I need the assistance of experts in the house on groupping the workbooks in the folder. The script will run through or loop through the folder by counting the rows and merge similar workbooks based on number of rows in one sheet. I will not mind if the sheets I will be getting at the end will be in separate worksheets in a workbook.

Thanks for your usual assistance.

akin · Jun 24th 2021

Noted, sir. I now saw the symbol;I was actually looking for it.

I am trying to analyse some American stock options historical price using standard deviation method to pick stock with highest price move as can be seen in the summary table attached.

I copied the script from a book I am reading on it. When I tried to apply the script, it was not running with the workbook (the sample I attached).

Please help me with it for any modification needed. Thanks.

akin · Jun 24th 2021

I am very sorry for that.

You are right. That is not the whole code; I copied the first aspect. The code is too long and I did not what to stress you, thinking that if one worked I will be able to manipulate my way through the rest. The whole code is:

Code

"Sub spikes ( )
Dim WindowlLength As Integer
Dim StdDevRange As Range


WindowLength = 20


'Column headings
Cells(1, "A") = "Symbol"
Cells(1, "B") = "Date"
Cells(1, "E") = "Close"
Cells(1, "F") = "Price Change"
Cells(1, "G") = "Log Change"
Cells(1, "H") = "Spike"


'Calculate price change and log of price change
DataRow = 3
While Cells(DataRow, "A") <> ""
If Cells(DataRow, "A") = Cells(DataRow - 1, "A") Then
Cells(DataRow, "F") = Cells(DataRow, "E") / Cells(DataRow - 1, "E")
Cells(DataRow, "G") = Log(Cells(DataRow, "E") / Cells(DataRow - 1, "E"))
End If
DataRow = DataRow + 1
Wend


'Calculate price spikes in standard deviations
DataRow = WindowLength + 3
While Cells(DataRow, "A") <> ""
If Cells(DataRow, "A") = Cells(DataRow - _
WindowLength - 1, "A") Then
Set StdDevRange = Range("G" & (DataRow - _
WindowLength) & ":" & "G" & (DataRow - 1))
Cells(DataRow, "H") = Cells(DataRow, "F") / _
(Application.WorksheetFunction.StDev(StdDevRange) _
* Cells(DataRow - 1, "E"))
End If


Dim DataRow As Long
Dim SummaryRow As Long
Dim LastDataRow As Long
Dim ReferenceTicker As String
Dim Count As Integer
Dim Criterion As Double
Dim IterationIndex As Integer
Dim ScoreColumnName As String
Dim SummaryColumn_2 As Integer
Dim RangeString As String


IterationIndex = 0
For Criterion = 0.5 To 4 Step 0.5
DataRow = 2
Count = 0
ReferenceTicker = Cells (DataRow, "A")


‘Create a sum for each ticker and store in column G
While Cells (DataRow, "A") <> ""
If Cells (DataRow, "A") = ReferenceTicker Then
If Abs (Cells (DataRow, "F")) > Criterion Then
Count = Count + 1




End If
Else
ReferenceTicker = Cells (DataRow, "A")
DataRow = DataRow - 1
Cells (DataRow, "G") = Count
Count = 0
End If
DataRow = DataRow + 1
Wend
Cells (DataRow - 1, "G" ) = Count


‘Create summary table-add data after each pass through the file
LastDataRow = DataRow - 1
SummaryRow = DataRow + 2
ScoreColumnName = ">" & Criterion & " StdDev"
SummaryColumn_2 = IterationIndex + 2
Cells (SummaryRow, SummaryColumn_2) = ScoreColumnName
If Iteration Index = 0 Then
Cells (SummaryRow, "A") = “Ticker"
End If
SummaryRow = SummaryRow + 1


For DataRow = 2 To LastDataRow
If Cells (DataRow, "G") <> “ " Then
Cells (SummaryRow, "A") = Cells (DataRow, "A")
Cells (SummaryRow, SummaryColumn_2) = Cells (DataRow, "G")
SummaryRow = SummaryRow + 1
End If
Next DataRow


‘Begin next pass through the file
IterationIndex = IterationIndex + 1
Next Criterion


‘Format summary table
RangeString = "A" & (LastDataRow + 4) &_
":" &"I" & (SummaryRow - 1)
Range (RangeString) .Select
Selection.NumberFormat = "0"
End Sub"

Display More

And workbook to apply it to is attached as first attachment

After the vba script has been run, it will produce a table similar to the one in second attachment.

In all, this script set to achieve on the workbook:

1. Align record in the Merged worksheet (that consist five different data each consisting 252 rows) of data base on date and remove unmatched ticker or row of data

2. Remove blank row of data

3. Create extra columns for calculation like 'price change', 'log of price change', 'standard deviation' and 'price spike'

4. Finally, produce the summary table as seen in the attached table

I really appreciate your kind gesture. Once again, I am sorry for my early attitude. Thanks.

akin · Jun 23rd 2021

Thanks. This is it.

akin · Jun 23rd 2021

I am sorry for that. I am desperate for quick answer. It will not repeat itself. The cross post is in VBAexpress. Thanks

akin · Jun 23rd 2021

Thanks. But I don't understand.

akin · Jun 23rd 2021

Pls, I am new to VBA. I copy this script below from a book on how to calculate standard deviation on a data in a sheet and record in separate column.

The problem I am having is that the script is not running. Please, what could be the reason? Or rather help me modify it. Thanks.

The script:

Code

Dim WindowlLength As Integer
Dim StdDevRange As Range


WindowLength = 20


'Column headings
Cells(1, "A") = "Symbol"
Cells(1, "B") = "Date"
Cells(1, "E") = "Close"
Cells(1, "F") = "Price Change"
Cells(1, "G") = "Log Change"
Cells(1, "H") = "Spike"


'Calculate price change and log of price change
DataRow = 3
While Cells(DataRow, "A") <> ""
If Cells(DataRow, "A") = Cells(DataRow - 1, "A") Then
Cells(DataRow, "F") = Cells(DataRow, "E") / Cells(DataRow - 1, "E")
Cells(DataRow, "G") = Log(Cells(DataRow, "E") / Cells(DataRow - 1, "E"))
End If
DataRow = DataRow + 1
Wend


'Calculate price spikes in standard deviations
DataRow = WindowLength + 3
While Cells(DataRow, "A") <> ""
If Cells(DataRow, "A") = Cells(DataRow - _
WindowLength - 1, "A") Then
Set StdDevRange = Range("G" & (DataRow - _
WindowLength) & ":" & "G" & (DataRow - 1))
Cells(DataRow, "H") = Cells(DataRow, "F") / _
(Application.WorksheetFunction.StDev(StdDevRange) _
* Cells(DataRow - 1, "E"))
End If

Display More

akin · Jun 11th 2021

Thanks

When I tried that. Meaning, when I was pressing F8 repeating and the lines got to 'FolderName=. SelectedItem(1)&"\" ' it tried to open source folder. And when I picked it, it failed to performed any function. There was no error generated and it stopped there. I mean the F8 refused to go pass there. Thanks alot.

akin · Jun 10th 2021

Thanks alot. It worked perfectly.

Sorry for this. I have a slight problem; I first used it with my sample folder that contain just 4 workbooks and it worked, but when I wanted to use it with the real folder containing 380 workbooks it failed to work. It did not respond at all. Please what could be responsible? Thanks

akin · Jun 10th 2021

Thanks.

Let me try it.

akin · Jun 10th 2021

Thanks

Each file is like these ones

AAWW.xlsm ABNB.xlsm

akin · Jun 10th 2021

Pls, I need help on how to merge multiple excel workbooks into single worksheet but with demarcation. I mean I want to know where one workbook data starts and ends, preferably filling the entire first column with workbook name.

What this mean is that as each workbook is copying to the new worksheet, it will pick its workbook name and use it to fill entire first column in the new worksheet and do that to all workbooks.
I had tried the code below before but I was giving me 'compile error: Label not define' . I want to know what is wrong with the code. Or preferably a new one.

Code

Sub Button2_Click()
Dim Wkb As Workbook
Dim wbDest As Workbook, shtDest As Worksheet, source As Worksheet
Dim path As String, ThisWB As String, Filename As String
Dim CopyRng As Range, Dest As Range
Dim currLastrow As Long, prevlastrow As Long        On Error GoTo err_exit    Application.EnableEvents = False    Application.ScreenUpdating = False
    currLastrow = 2 ' Row to start on in the sheets you are copying from        ThisWB = ActiveWorkbook.Name    Set shtDest = ActiveWorkbook.Sheets(1)        path = GetDirectory("Select a folder containing Excel files you want to merge")        Filename = Dir(path & "\*.xls", vbNormal)    If Len(Filename) = 0 Then Exit Sub        Do Until Filename = vbNullString            If Not Filename = ThisWB Then                    Set Wkb = Workbooks.Open(Filename:=path & "" & Filename)            Set source = Wkb.Sheets(1)            Set CopyRng = source.Range(source.Cells(currLastrow, 1), source.Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count))                        Dest = shtDest.Range("B" & shtDest.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)            CopyRng.Copy Dest                        Wkb.Close False                        prevlastrow = currLastrow            currLastrow = shtDest.Cells(shdest.Rows.Count, "B").End(xlUp).Row            shdest.Cells(prevlastrow, "A").Resize(currLastrow - prevlastrow + 1).Value = Filename        End If                Filename = Dir()    Loop        shdest.Range("A1").Select        Application.EnableEvents = True    Application.ScreenUpdating = True        MsgBox "Done!"        Exit Sub

GoTo err_exit:    Application.EnableEvents = True    Application.ScreenUpdating = True
End Sub

Thanks a lot.

Posts by akin

VBA: How to copy source workbook name to fill first column

Group Workbooks in a Folder based on Number of Rows

Group Workbooks in a Folder based on Number of Rows

Group Workbooks in a Folder based on Number of Rows

Script not Running

Script not Running

Script not Running

Script not Running

Script not Running

Script not Running

VBA to merge multiple workbooks with demarcation

VBA to merge multiple workbooks with demarcation

VBA to merge multiple workbooks with demarcation

VBA to merge multiple workbooks with demarcation

VBA to merge multiple workbooks with demarcation