Posts by keal

    I'm kind of new to VBA i PowerPoint and hope someone with better knowledge can suggestion a solution. I want the program to move part of upper right corner of a *.png files to PowerPoint slide with animation.


    I have let say three folders with let say 40 *.png files in each folder (All three folders are in one joined folder) I want to open the first folder in the joined folder, open the first *.png file in that folder take a square of the upper right corner (or take a print screen of the entire open picture) open the PowerPoint and paste the copied piece into the PowerPoint slide, close that *.png and open the next *.png in the same folder do the same and add it in PowerPoint with appear animation (or some animation) and do so for all 40 *.png pictures. When that folder's pictures are moved open the next folder and do the same thing but on the next slide in the same PowerPoint file. And do this on all available folders and *.png files.


    Hope someone can post a suggestion or can send me a link on similar VBA code


    Thank you

    Best Regards

    I have a some issue which probably is very easy to solve for someone who knows VBA better then me. I have done some patches based on what I have found but it does not really what I want.


    I have several *.txt-files (70) which I can open in *.xls treat the data and cause two charts. So far it all works as I want, but the issue is that I want to move/copy the two charts from first *.xls-file to the first slide of a PowerPoint next to each other. Then the next two charts from the next *.xls file be placed on the next PowerPoint slide and so on; by the end a PowerPoint file with 70 pages/slides on each slide two charts next to each other from the *.xls files.


    I guess the more beautiful solution would be to have the chart on top of each other with appear animation, so one slide/page with 70x2 charts which you can scroll between.


    My code below open a new PowerPoint file for each chart!


    I appreciate any suggestion and help to improve the code below.


    Thank you,



    Thank you ashu1990 for the suggestion. Unfortunately this change only pop a alert code, with text


    Run-time error '9'
    Subscript out of range.


    When selecting debug it select the above changed line.


    Could you please advice what needs to be improved.


    Thank you,

    I have the code below which is mostly copy/paste since I'm very new to VBA.


    What I want the program to do:
    Let say I have a folder with three files name 1, 2, 3.txt and a joined_123.xls. I want to open file1 convert it to *.xls do some calculations, save it as *.xls move the calculation result to joined_123, close file 1. Open file 2 do the same calculation and movement to the joined_123 close file 2 and so on.


    What the code does:
    As the code do in below it open file 1 do the calculations and movement to the joined_123 file but keep the file 1 open. Then it opens file 2 do the same thing and so on.


    What I need help with:
    How do I re-activate the first opened file and close it before opening file 2. I want it to only keep joined_123 open and populate fields from the files without keeping each file open. (I have highlighted the part which I think need to be improved, but I might be totally wrong as well, since none of the ways I have tried have worked.)


    Why
    I have many files which this needs to be applied on. The way it is now I can only do the code for ~90 *.xls files then I will run out of memory and a alert popup.


    Thank you for any improvement suggestions


    Code
    1. Sub Macro1openwaveformfiles() ' ' Macro1 Macro ' ' Keyboard Shortcut: Ctrl+r ' screenUpdateState = Application.ScreenUpdating statusBarState = Application.DisplayStatusBar calcState = Application.Calculation eventsState = Application.EnableEvents displayPageBreakState = ActiveSheet.DisplayPageBreaks 'note this is a sheet-level setting 'turn off some Excel functionality so your code runs faster Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.Calculation = xlCalculationManual Application.EnableEvents = False ActiveSheet.DisplayPageBreaks = False 'note this is a sheet-level setting Dim MyFolder As String Dim myFile As String Dim folderName As String Dim Workbook As String Dim filename As String Dim c As Long Dim k As Long Dim j As Long Dim p As Long Dim d As Long c = 4 j = 4 k = 2 p = 3 d = 3 With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False If .Show = -1 Then folderName = .SelectedItems(1) End If End With myFile = Dir(folderName & "\*.txt") Do While myFile <> "" Workbooks.OpenText filename:=folderName & "\" & myFile, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ TrailingMinusNumbers:=True Cells.Select Selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False 'ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False Range("A300038").Select ActiveCell.FormulaR1C1 = "Max" Range("A300039").Select ActiveCell.FormulaR1C1 = "Min" Range("B300038").Select ActiveCell.FormulaR1C1 = "=MAX(R[-300003]C:R[-1]C)" Range("B300038").Select Selection.AutoFill Destination:=Range("B300038:C300038"), Type:= _ xlFillDefault Range("B300038:C300038").Select Selection.AutoFill Destination:=Range("B300038:C300039"), Type:= _ xlFillDefault Range("B300038:C300039").Select Range("B300039").Select ActiveCell.FormulaR1C1 = "=MIN(R[-300003]C:R[-1]C)" Range("C300039").Select ActiveCell.FormulaR1C1 = "=MIN(R[-300003]C:R[-1]C)" Range("C300040").Select ActiveWindow.SmallScroll Down:=12 Range("B300040").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=R[-2]C-R[-1]C" Range("B300040").Select Selection.AutoFill Destination:=Range("B300040:C300040"), Type:= _ xlFillDefault Range("B300040:C300040").Select Range("A300040").Select ActiveCell.FormulaR1C1 = "Diff" Range("A300041").Select filename = ActiveWorkbook.Name ActiveWorkbook.SaveAs filename:=folderName & "\" & Replace(myFile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False Range("B300038:B300040").Copy Windows("Joined_DC_Level_I.xlsx").Activate Cells(j, c).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False p = j - 1 Cells(p, c).Select ActiveCell.FormulaR1C1 = filename d = j - 2 Cells(d, c).Select ActiveCell.FormulaR1C1 = "DC" & k c = c + 1 k = k + 2 If k = 18 Then k = 2 End If If c = 12 Then c = 4 j = j + 5 End If 'ThisWorkbook.SaveAs ActiveWorkbook.Save [size=14][COLOR=#00ff00] Application.Workbooks("filename").Activate[/COLOR][/SIZE] [size=14][COLOR=#00ff00] ActiveWorkbook.Close SaveChanges:=True[/COLOR][/SIZE] 'ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'wb.Close False 'Ensure Workbook has closed before moving on to next line of code DoEvents 'Get next file name myFile = Dir Loop 'ThisWorkbook.SaveAs True For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name Then 'wb.SaveAs Filename:=Path & wb.Name ', FileFormat:=51 wb.Close False End If Next wb 'ThisWorkbook.Close False Application.ScreenUpdating = screenUpdateState Application.DisplayStatusBar = statusBarState Application.Calculation = calcState Application.EnableEvents = eventsState ActiveSheet.DisplayPageBreaks = displayPageBreaksState 'note this is a sheet-level setting End Sub

    Thank you JonathanVH, but I'm very new to VBA so I don't really understand how I should use/add your suggestion to my code for making it loop through. Even if I did not stated it, it would be very beneficial if the code can also save the *.xls files (but that is not the main thing.) If you could explain how I can use your suggestion to use it, it would be great. I need to be able to determine which folder to select files from and select column E:E and move it to a different file each column and sheet.


    Thank you,

    Thank you JonathanVH for your help and suggestion. It does what I want it to do. But this was only to understand how to do what I'm in need for doing. It might be to much to ask but could you please give me a suggestion on how to do the below question. I have tried with your suggestion in different positions but nothing give any correct output.


    I have folder with let say 40 files and I want to open one by one. Copy column E:E to a different file (Joined_test.xlsm) columnAsheet1, then open next file copy column E:E to sheet2columnA and so on in let say five sheets. Then continue with files in the folder and do the same thing for next five files to column B in each sheet and so on until 8 colums are populated in five sheets. Basically what above code is doing but with files and coping instead.


    The code below which I have, open each file and copy it to the same sheet, which is not what I want to do.


    Any suggestions on how to solve it is very appreciated
    Thank you


    I'm kind of new to VBA and trying different things.
    I have below code which put number 0-5 in column A sheet1, 6-11 column B sheet 1 and so on, then it select sheet2 and put 36-41 in column A and so on. But what I want it to do is to put 0-5 in column A sheet1 then 6-11 in column A sheet2 and so on until all three column A is filled in all three sheets. Then have 18-23 in column B sheet1, 24-29 column B sheet2 and so on. Then do the same with column C and so on until column F.


    Thank you for your help


    I'm starter with VBA and have managed to complete below code with some help, but have one last task to figure out for making the code as I want it to do. I want to apply below code on a folder with several *.txt files. The code works well but I need to manually move files to different folders and run the code. So to make it more automated I need to do some improvements which I hope I can get some suggestion on.


    I have let say 40 *.xls files in the folder, I have also a *.xlsm file with eight sheets named (PC2,4,6...-16) in the same folder; I want to copy the column E from the first *.xls file to the "joined_test.xlsm" sheet PC2(sheet1) column B, then copy column E from *.xls file 2 to "joined_test.xlsm" sheet PC4(sheet2) column B and do this until file 8 column E is copied to sheet PC16(sheet8) column B. Then copy column E from file 9 to "joined_test.xlsm" sheet PC2(sheet1) column C and so on until 8 sheets five columns on each sheet is populated with values from the *.xls files.


    Different way to achieve the same result would be to do this instead: From *.xls file 1 copy column E to "joined_test.xlsm" sheet PC2 (sheet1) column B, then open *.xls file 9 and copy column E to "joined_test.xlsm" sheet PC2(sheet1) column C and so on until 8 columns are populated with values in sheet PC2(sheet1). Then select *.xls file 2 copy column E to "joined_test.xlsm" sheet PC4(sheet2) column B, then copy column E from *.xls file 10 to sheet PC4(sheet2) column C and so on.


    So to keep the column the same and change sheet for every new open *.xls file or to keep the same sheet and change column for every new open *.xls file, the result of both should be the same.


    I guess I need to have some kind of loop in the loop solution, but not really sure how to do it. I appreciate all the help. (I have change the size of the part in the code which I think need to be improved)


    Code
    1. Sub Macro8()'' Macro8 Macro'' Keyboard Shortcut: Ctrl+d'Dim MyFolder As String Dim myfile As String Dim folderName As String Dim c As Long Dim k As Long c = 2 k = 2 With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False If .Show = -1 Then folderName = .SelectedItems(1) End If End With myfile = Dir(folderName & "\*.txt")  Do While myfile <> "" Workbooks.OpenText Filename:=folderName & "\" & myfile, Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _ xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ TrailingMinusNumbers:=True Cells.Select Selection.Replace What:=".", Replacement:=".", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ ReplaceFormat:=False Columns("E:E").Select Selection.FormatConditions.AddTop10 Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority With Selection.FormatConditions(1) .TopBottom = xlTop10Top .Rank = 1 .Percent = False End With With Selection.FormatConditions(1).Interior .PatternColorIndex = xlAutomatic .Color = 10498160 .TintAndShade = 0 End With Selection.FormatConditions(1).StopIfTrue = False ActiveWorkbook.SaveAs Filename:=folderName & "\" & Replace(myfile, ".txt", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False Selection.Copy [B][SIZE=14px] 'Windows("Joined_test.xlsm").Activate Workbooks("Joined_test.xlsm").Sheets("PC" & k).Activate Cells(1, c).EntireColumn.Select ActiveSheet.Paste Cells(34, c).Select ActiveCell.FormulaR1C1 = "CC" & k c = c + 1 k = k + 2[/SIZE][/B] 'Ensure Workbook has closed before moving on to next line of code DoEvents 'Get next file name myfile = Dir Loop For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name Then 'wb.SaveAs Filename:=Path & wb.Name ', FileFormat:=51 wb.Close False End If Next wb 'ThisWorkbook.Close False 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub[/I][I]

    [/I]

    I'm very new to VBA in *.xls and hope could get some help.


    I have a file with about 100 rows and 8 columns. I want to find the max value on each column and calculate the standard deviation on values around the max value. So for example if the max value is found on row 69 I want the code to calculate the standard deviation from row 64-74.


    I have managed to find a code, in this forum, how to select the cell with max value, but I can't make it to select the max value cell before calculating the stdv. Please improve the code or suggest new way how I can get the stdv around the max value in my columns.


    Thank you,


    [vba]
    Dim rX As Excel.Range
    Dim rY As Excel.Range


    Dim lngMax As Double


    For Each rX In Range("o34:o114")
    If rX = Application.WorksheetFunction.Max(Range("o34:o114")) Then
    Set rY = rX
    Exit For
    End If
    Next


    If Not rY Is Nothing Then
    rY.Select
    Range("o127").Value = rY.Address
    Range("o128").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=STDEV.P(R[-58]C:R[-49]C)"
    End If



    Set rX = Nothing
    Set rY = Nothing[/vba]