Jump to content
News Ticker
  • Welcome to the Community
  • Use the forum to troubleshoot your Excel & VBA Problems
  • We will be launching a new website soon! www.ExcelWTF.com/Learn ! Join us to learn VBA from the ground up!

Caleeco

Administrators
  • Content count

    226
  • Joined

  • Last visited

  • Days Won

    34

Caleeco last won the day on February 1

Caleeco had the most liked content!

Community Reputation

15 Good

About Caleeco

  • Rank
    Veteran Lvl.1
  1. Slow Running Code

    Hey, That's excellent news! Glad it is now working. Haha, yes that's the trouble with coding. Seemingly insignificant things can have big consequences! Ah ok yes, sounds like it would require a lot of modification. Almost better to wait until the next gen of tech is out and build a shiny new system No problem, glad I could help. Like always, stop by the forum if you have any other Excel/VBA problems you'd like me to take a look at Cheers Caleeco MARKED AS SOLVED
  2. Slow Running Code

    Hey mate, Back from work! Hmm sorry to hear the bad news Thanks for the detailed description, it certainly help pinpoint the problems. Problem 1 - Data not being output to the correct sheets This is an oversight on my part the final part of the macro (where data is written back to the sheet) is not sheet specific. So it will always output on the sheet it was run on. D'oh! Please find this line Set Destination = Range(strOutputCol & "4") and change it to Set Destination = ws.Range(strOutputCol & "4") Problem 2 - CPU load I'm not surprised, you're working with some large data with thousands of formulas. Every time you add (with the code) or delete (manually) columns of data the whole sheet needs to re-calculate. This is what is causing the cooling system to be put to the test! This can be avoided by removing formulas you no longer need. Eg. Pasting Values over formulas. If that's not an option, i would consider a CPU upgrade Problem 3 - Data Missing Is this the output for column O? Not sure why that would occur. Could you please send me the updated sheet (where the blank columns/formulas are now filled in for all blocks). I never received it on my email ([email protected]). Many Thanks Caleeco
  3. Slow Running Code

    I'm have returned from the depths of VBA. With (hopefully) some working code! I have now modified it to run on ALL worksheets in the workbook and for all 4 blocks. On my machine.. it managed to process 12,100 lines of data in about 6 seconds. Even i'm pretty astounded in how much quicker Arrays are! I did some self checking of the output data, but am reliant on your superior attention to detail to spot any mistakes. let me know if you see anything wrong. Again. Please ensure the two statements at the top of the module are also copied across! Option Explicit Option Base 1 Sub Superfast_AIO() '//Source: www.ExcelWTF.com '//Purpose: Execute data processing to all sheets within active workbook. ' Focus given to speed for Version 2.0 Dim sh As Worksheet Application.ScreenUpdating = False For Each sh In ActiveWorkbook.Worksheets If Not sh.Name = "EURGBP" Then Call DataProcessor(sh.Name, "SH", "S", "J", "FO/RV") Call DataProcessor(sh.Name, "SL", "AA", "N", "FO/RV") Call DataProcessor(sh.Name, "SH", "AI", "K", "FO") Call DataProcessor(sh.Name, "SL", "BP", "O", "FO") End If Next sh Application.ScreenUpdating = True End Sub Function DataProcessor(strWS As String, strSearch As String, strYesNoCol As String, strOutputCol As String, strType As String) '//Source: www.ExcelWTF.com '//Purpose: Processes all lines of data and searches for FO/RV values. Outputs according to defined logic. ' Focus given to speed for Version 2.0 Dim ws As Worksheet Dim arrYesNO() As Variant, arrFind() As Variant, arrOutput() As Variant Dim lr As Long, i As Long, j As Long Dim strTest As String, strOut As String Set ws = Sheets(strWS) lr = ws.Range("B" & Rows.Count).End(xlUp).Row ReDim arrOutput(lr - 3) 'Set the maximum size of the output array arrYesNO = ws.Range(strYesNoCol & "4:" & strYesNoCol & lr) For i = LBound(arrYesNO) To UBound(arrYesNO) If arrYesNO(i, 1) = strSearch Then arrFind = Range(ws.Range(strYesNoCol & i + 3).Offset(, 1), ws.Range(strYesNoCol & i + 3).End(xlToRight)) For j = LBound(arrFind, 2) To UBound(arrFind, 2) If i + j = lr - 1 Then GoTo done strTest = arrFind(1, j) If strType = "FO/RV" Then If strTest = "FO" Or strTest = "RV" Then If IsEmpty(arrOutput(i + j - 1)) Then arrOutput(i + j - 1) = strTest Else strOut = strTest & "/" & arrOutput(i + j - 1) Select Case strOut Case "RV/RV" arrOutput(i + j - 1) = "RV" Case "RV/FO" arrOutput(i + j - 1) = "FO" Case "FO/RV" arrOutput(i + j - 1) = "FO" Case "FO/FO" arrOutput(i + j - 1) = "FO" End Select End If ElseIf arrFind(1, j) = "" Then GoTo out End If Else If arrFind(1, j) = "" Then GoTo out ElseIf IsEmpty(arrOutput(i + j - 1)) And strTest = "FO" Then arrOutput(i + j - 1) = strTest End If End If Next j End If out: Next i done: Dim Destination As Range Set Destination = ws.Range(strOutputCol & "4") Set Destination = Destination.Resize(UBound(arrOutput), 1) Destination.Value = Application.Transpose(arrOutput) End Function Hope that helps Caleeco
  4. Slow Running Code

    Hi OldFella, Sorry for the delayed reply, this time difference is killer! Just got back from work will be doing some more coding this evening. Haha... bigger is better it would seem. That looks promising, I would anticipate the all 4 blocks to run in less than 1 minute (although the last two blocks have many more columns to process so we'll see). I'll post up once I have some tested code. Haha whisky is my poison of choice! Cheers Caleeco
  5. Slow Running Code

    Not going to lie, that was an intense coding session! The new array method is drafted (looks promising). I tested it on the 'EURGBP_h12Data' sheet for the FIRST SH block only. Please note the first two lines above the sub. Option Explicit & Option Base 1. The second one is VERY important, and the code wont work properly without it so make sure it's at the top of your module. The code below runs in a few seconds for 3500 rows for the first block. let me know if it works for you, and I will incorporate the other 3 blocks and get it to loop all sheets! Option Explicit Option Base 1 Sub All_in_One_v2() '//Source: www.ExcelWTF.com '//Purpose: Execute data processing to all sheets within active workbook. ' Focus given to speed for Version 2.0 Dim ws As Worksheet Dim arrYesNO() As Variant, arrFind() As Variant, arrOutput() As Variant Dim lr As Long, i As Long, j As Long Dim strTest As String, strOut As String Set ws = Sheets("EURGBP_h12Data") lr = ws.Range("B" & Rows.Count).End(xlUp).Row ReDim arrOutput(lr - 3) 'Set the maximum size of the output array '// "SH", "S", "J", "FO/RV" arrYesNO = ws.Range("S4:S" & lr) For i = LBound(arrYesNO) To UBound(arrYesNO) If arrYesNO(i, 1) = "SH" Then arrFind = ws.Range("T" & i + 3, ws.Range("T" & i + 3).End(xlToRight)) For j = LBound(arrFind, 2) To UBound(arrFind, 2) If i + j = lr - 1 Then GoTo done strTest = arrFind(1, j) If strTest = "FO" Or strTest = "RV" Then If IsEmpty(arrOutput(i + j - 1)) Then arrOutput(i + j - 1) = strTest Else strOut = strTest & "/" & arrOutput(i + j - 1) Select Case strOut Case "RV/RV" arrOutput(i + j - 1) = "RV" Case "RV/FO" arrOutput(i + j - 1) = "FO" Case "FO/RV" arrOutput(i + j - 1) = "FO" Case "FO/FO" arrOutput(i + j - 1) = "FO" End Select End If ElseIf arrFind(1, j) = "" Then GoTo out End If Next j End If out: Next i done: Application.ScreenUpdating = False Dim Destination As Range Set Destination = Range("J4") Set Destination = Destination.Resize(UBound(arrOutput), 1) Destination.Value = Application.Transpose(arrOutput) Application.ScreenUpdating = True End Sub Cheers Caleeco
  6. Slow Running Code

    Hi Mate, Didnt see the new sheet in my inbox, do you mind checking it's not stuck in your outbox? Cheers Caleeco
  7. Slow Running Code

    Hey OldFella, Thanks for the question. I have received your example file, and have some thoughts as to why it may be taking so long: Generally interacting with the Worksheet using VBA will be slow for very large datasets. I am investigating using arrays instead which should be quicker. The loop of 3600 rows occurs 4 times, as the DataProcessor() Function is called 4 times. I will try and modify this to that loop only occurs once. This should cut run time by 75% in all cases. If you could ensure that there are no blanks inbetween SH, SH+1, SH+x values it would speed up the code (see Picture below). I will need to make a code edit to benefit from this. The speed of the sheet will depend on how many times data is moved between columns and rows. So a sheet with 4000 rows, may run quicker than that with 3600 rows provided there are less found values (FO, RV) to move around the sheet. If you could send me an updated sheet with the change above, it would be most helpful. Many Thanks Caleeco
  8. User Input Pop-up to Update VBA String

    Hi OldFella, Thanks for the question! I like having coding projects to work on! Ah, that would indeed be time-consuming to edit the code every time. I would suggest a slightly different approach, I would get VBA to loop all the sheets in the workbook and then give the macro the sheet name automatically (so you don't need to keep entering them) Please note the following: The new code MUST be in the 'ThisWorkbook' module. Now that you have created the All_in_One() macro, you can delete the other small subroutines I had made. This will run code on ALL the sheets in the workbook, EXCEPT the 'Back-test Template' sheet (case-sensitive). If you need to exclude more sheet names, I can show you how to edit the code. This can be modified to run on all sheets of all open workbooks if needed, let me know I will send you my example file via email Sub All_in_One() '//Source: www.ExcelWTF.com '//Purpose: Execute data processing to all sheets within active workbook. Excluding Template sheet. Dim sh As Worksheet Application.ScreenUpdating = False For Each sh In ActiveWorkbook.Worksheets If Not sh.Name = "Back-test Template" Then Call DataProcesser(sh.Name, "SH", "Q", "H", "FO/RV") Call DataProcesser(sh.Name, "SL", "Y", "L", "FO/RV") Call DataProcesser(sh.Name, "SH", "AG", "I", "FO") Call DataProcesser(sh.Name, "SL", "BN", "M", "FO") End If Next sh Application.ScreenUpdating = True End Sub Function DataProcesser(wsBT As String, sYesNo As String, sYesNoCol As String, sOutputCol As String, sType As String) '//Source: www.ExcelWTF.com '//Purpose: To process horizontal data entries and transpose them with set criteria On Error GoTo out Dim ws As Worksheet Dim rYesNO As Range, r As Range Dim lr As Long, items As Long, i As Long Dim sItem As String Set ws = Sheets(wsBT) ws.Activate lr = ws.Range(sYesNoCol & Rows.Count).End(xlUp).Row Set rYesNO = ws.Range(sYesNoCol & "3:" & sYesNoCol & lr) items = ws.Range(Cells(1, ws.Range(sYesNoCol & 1).Column), Cells(1, ws.Range(sYesNoCol & 1).Column).End(xlToRight)).Count For Each r In rYesNO If r.Value = sYesNo Then For i = 0 To items - 1 sSeq = ws.Range(sYesNoCol & r.Row).Offset(, i + 1).Value If sType = "FO" Then If sSeq = "FO" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = "FO" Else If sSeq = "RV" And sOutput = "RV" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = "RV" ElseIf sSeq = "RV" And sOutput = "FO" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = "FO" ElseIf sSeq = "FO" And sOutput = "RV" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = "FO" ElseIf sSeq = "FO" And sOutput = "FO" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = "FO" ElseIf sOutput = "" And sSeq = "FO" Or sSeq = "RV" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = sSeq End If End If Next i End If Next r ws.Range(sOutputCol & ws.Range("G" & Rows.Count).End(xlUp).Offset(1).Row & ":" & sOutputCol & ws.Range(sOutputCol & Rows.Count).End(xlUp).Offset(1).Row).ClearContents Exit Function out: MsgBox "Ooops... looks like something went wrong. Please check code/output", vbOKOnly + vbExclamation, "Error" End Function Let me know if that works. If you still would prefer the input box let me know and I'll code something up for you Thanks Caleeco
  9. Getting Rid of the Hidden Content of Blank Cells

    Hi OldFella, Thanks for the link & the values of 'c', it does shed some light on it. It appears as if one of your formulas is returning an error like a #N/A or #DIV0 so the VBA code has trouble evaluating it for length. I was struggling to recreate it on my spreadsheet, but from some reading online, this may help: I have added an IFERROR statement, to bypass trying to evaluate its length with the LEN() function. Sub doit_for_AllWorksheets() '// www.ExcelWTF.com '// Purpose: Clear contents of problem cells Dim ws As Worksheet Dim c As Range With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With For Each ws In Worksheets For Each c In ws.UsedRange If IsError(c.Value2) Then 'Move on Else If Not IsEmpty(c) And Not c.HasFormula And Len(c.Value2) = 0 Then c.ClearContents End If End If Next c Next ws With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub Let me know if it works, Many Thanks Caleeco
  10. Well that's some excellent news! Apologies for the obvious errors I had left, but great to see you figured out what was wrong and corrected them! Good idea of having them run off a single button click Wow! That's sounds like quite a project. Glad I was able to help shorten the lead time on completion & hopefully remove hours of manual data entry! (it's what VBA is built for!) Haha, thanks for the beer... it's made me thirsty, so going to crack open a real one Enjoy your weekend! Please mark as solved if you're happy with the current solution I'm off to your other thread to see if I can figure out that error you've been getting. Cheers Caleeco
  11. Getting Rid of the Hidden Content of Blank Cells

    Marked as unsolved! Hmm not sure what's up there. Can you please do the following: Run the code again Run the Debug when you get the error The hover your mouse over the letter 'c' and tell me what pops up in the textbox It will give me a clue as to what the problem is! Many Thanks Caleeco
  12. All done mate! The new blocks raised an interesting problem! The previous blocks (LC, RV, FO FO etc) were all contiguous, where as the new blocks sometimes had blanks in the first column eg SL+1. This caused some problem with the existing code. So I have modified it to search how wide the header rows are (row 1) and use that as the search width. This means a NEW version of the code. I have also incorporated another argument to the function for your latest requirement eg. when you're looking for FO values only! Sorry, for giving you another round of testing to do. Let me know how you get on: Sub FO_RV_SH() 'Call DataProcesser(Sheet Name, the code you're looking for eg SL/SH, The column the SL/SH is in, the column you want to output to, is it FO/RV or just FO data?) Call DataProcesser("Back-test Layout v3", "SH", "Q", "H", "FO/RV") End Sub Sub FO_RV_SL() Call DataProcesser("Back-test Layout v3", "SL", "Y", "L", "FO/RV") End Sub Sub FO_SH() Call DataProcesser("Back-test Layout v3", "SH", "AG", "I", "FO") End Sub Sub FO_SL() Call DataProcesser("Back-test Layout v3", "SL", "BM", "M", "FO") End Sub Function DataProcesser(wsBT As String, sYesNo As String, sYesNoCol As String, sOutputCol As String, sType As String) '//Source: www.ExcelWTF.com '//Purpose: to process horizontal data entries and transpose them with set criteria Dim ws As Worksheet Dim rYesNO As Range, r As Range Dim lr As Long, items As Long, i As Long Dim sItem As String Application.ScreenUpdating = False Set ws = Sheets(wsBT) lr = ws.Range(sYesNoCol & Rows.Count).End(xlUp).Row Set rYesNO = ws.Range(sYesNoCol & "3:" & sYesNoCol & lr) items = ws.Range(Cells(1, ws.Range(sYesNoCol & 1).Column), Cells(1, ws.Range(sYesNoCol & 1).Column).End(xlToRight)).Count For Each r In rYesNO If r.Value = sYesNo Then For i = 0 To items - 1 sSeq = ws.Range(sYesNoCol & r.Row).Offset(, i + 1).Value If sType = "FO" Then If sSeq = "FO" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = "FO" Else If sSeq = "RV" And sOutput = "RV" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = "RV" ElseIf sSeq = "RV" And sOutput = "FO" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = "FO" ElseIf sSeq = "FO" And sOutput = "RV" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = "FO" ElseIf sSeq = "FO" And sOutput = "FO" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = "FO" ElseIf sOutput = "" And sSeq = "FO" Or sSeq = "RV" Then ws.Range(sOutputCol & r.Row).Offset(i).Value = sSeq End If End If Next i End If Next r ws.Range(sOutputCol & ws.Range("G" & Rows.Count).End(xlUp).Offset(1).Row & ":" & sOutputCol & ws.Range(sOutputCol & Rows.Count).End(xlUp).Offset(1).Row).ClearContents Application.ScreenUpdating = False End Function In this case... no The code runs on individual blocks, so their placement in the sheet is irrelevant. however, THERE MUST BE AN EMPTY COLUMN BETWEEN THE BLOCKS in row 1 Hope that helps Caleeco
  13. Hi Oldfella, I found the bug in the code, maybe I had one too many beers whilst coding Your requirement was: I obviously misread this and wrote the code below. ElseIf sSeq = "FO" And sOutput = "RV" Then sOutput = "RV" please replace it with the correct output here: ElseIf sSeq = "FO" And sOutput = "RV" Then sOutput = "FO" This should fix the issue you found, please let me know. I'm going to start work on the new blocks you have specified and will have some code for you by tonight. Cheers, Caleeco
  14. All done mate, I think! Given your scope has expanded I took the liberty of making a more significant code edit. Instead of repeating the same macro twice for slightly different columns, criteria etc; it's the perfect opportunity to use a couple sub-routines with a FUNCTION. If you're not familiar with functions, it's essentially a template of instructions you want VBA to execute. Each individual Sub-routine will pass it the variables that are subject to change eg "SL" or "SH", Output to column H or L etc. This makes updating the code later easier, as you've not repeated two large chunks of code that are nearly identical. So delete the two existing subroutines you have, and replace it with this: Sub FO_RV_SH() 'Call FO_RVc(Sheet Name, the code you're looking for eg SL/SH, The column the SL/SH is in, the column you want to output to) Call FO_RVc("Back-test Layout v2", "SH", "Q", "H") End Sub Sub FO_RV_SL() 'Call FO_RVc(Sheet Name, the code you're looking for eg SL/SH, The column the SL/SH is in, the column you want to output to) Call FO_RVc("Back-test Layout v2", "SL", "Y", "L") End Sub Function FO_RVc(wsBT As String, sYesNo As String, sYesNoCol As String, sOutputCol As String) Dim ws As Worksheet Dim rYesNO As Range, r As Range Dim lr As Long, items As Long, i As Long Dim sSeq As String, sColL As String Application.ScreenUpdating = False Set ws = Sheets(wsBT) lr = ws.Range(sYesNoCol & Rows.Count).End(xlUp).Row Set rYesNO = ws.Range(sYesNoCol & "3:" & sYesNoCol & lr) For Each r In rYesNO If r.Value = sYesNo Then items = Application.WorksheetFunction.CountIf(ws.Range(ws.Range(sYesNoCol & r.Row).Offset(, 1), ws.Range(sYesNoCol & r.Row).Offset(, 6)), "?*") For i = 0 To items - 1 sSeq = ws.Range(sYesNoCol & r.Row).Offset(, i + 1).Value sOutput = ws.Range(sOutputCol & r.Row).Offset(i).Value If sSeq = "RV" And sOutput = "RV" Then sOutput = "RV" ElseIf sSeq = "RV" And sOutput = "FO" Then sOutput = "FO" ElseIf sSeq = "FO" And sOutput = "RV" Then sOutput = "RV" ElseIf sSeq = "FO" And sOutput = "FO" Then sOutput = "FO" ElseIf sOutput = "" And sSeq = "FO" Or sSeq = "RV" Then sOutput = sSeq End If ws.Range(sOutputCol & r.Row).Offset(i).Value = sOutput Next i End If Next r ws.Range(sOutputCol & ws.Range("G" & Rows.Count).End(xlUp).Offset(1).Row & ":" & sOutputCol & ws.Range(sOutputCol & Rows.Count).End(xlUp).Offset(1).Row).ClearContents Application.ScreenUpdating = True End Function Let me know if you need more explanation for the setup above Alternatively, if you wish to keep two separate macros (as in the file you sent me). Add the line below to each respective sub-routine, just above the END SUB. This will stop the FO/RV being logged past the last row. wsBackTest.Range("H" & wsBackTest.Range("G" & Rows.Count).End(xlUp).Offset(1).Row, "H" & wsBackTest.Range("H" & Rows.Count).End(xlUp).Row).ClearContents and wsBackTest.Range("L" & wsBackTest.Range("G" & Rows.Count).End(xlUp).Offset(1).Row, "L" & wsBackTest.Range("L" & Rows.Count).End(xlUp).Row).ClearContents Hope that helps Let me know how you get on Thanks Caleeco
  15. Thanks for the feedback! Looks like the logic is pretty much there. Didnt think of the problem of it extending beyond the last row! (I will add some code to fix this). Spreadsheet received! Good to see you had a go at implementing your own version and building upon it further The helper columns, whilst not aesthetically pleasing, do offer efficiency savings. Coding it in VBA would: Increase macro running time Greatly increase the complexity of the code & make it harder to update. So it would be probably not be worthwhile at this stage, especially if the sheet is subject to change. We can re-review your requirements when the final sheet is built. With regard to the 'ct FO' problem you mentioned, you could implement some sort of fuzzy lookup to find any entires that CONTAIN "FO" or "RV". Ok no problem, let me know how you get on. I love coding challenges so send it my way if the current method doesnt give you what you need. Right, requirement set, beer in hand... time to start coding!
×