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!


Popular Content

Showing content with the highest reputation since 03/26/2017 in all areas

  1. 1 point
    Ah so simple! Thanks for your assistance. Now all I have to do is make the rest of the suite work and we'll be flying! Again, many thanks.
  2. 1 point
    Hi again Caleeco Sorry to be a pain but I've just been simulating the effect of the requested coding and I've found a small issue. There are times when not every symbol in 'Summary' col B will have a corresponding .csv file. I can readily overcome this by increasing the amount of data in each .csv file, but it complicates the coding slightly because instead of reading data from a specific cell in the .csv file it will now need to read the last value in the column. So, in items c) & h) above, please replace "Read the value in the .csv file cell B2" with "Read the last value in col B of the .csv file". That should ensure there is always a .csv file to correspond with each symbol in 'Summary' col B and hence each symbol would have a value in col F, although for safety it might be sensible to include some error trapping to allow for a situation where there is no corresponding .csv file. And of course the first line in d) of the upper block is no longer valid; there will now be multiple cells of data and different numbers of cells in each .csv file. In text mode, it's always the last value in the last line that has to be read. Thanks
  3. 1 point
    Hey Caleeco, I'm upgrading my dashboard with some new charts, however, space is a premium as most people in the office work on small laptop screens! 😶 Would you be able to help me with something i've dreamt up? Basically... i want to stack 2 charts one on top of the other. Then be able to click on Cell B3 to bring the first chart to the front (hiding the other one behind it), or click cell B4 to bring the second chart to the front. So it will look like they're coming out of nowhere 😁 My Chart names are 'Chart 1' and 'Chart 2' if you need them. Can you write some VBA magic? Z
  4. 1 point
    Ah, that's not a VITAL bit of code.. it's just generally good practice when using the SelectionChange Event. It basically prevents the code running if you select more than one cell with your mouse. Eg... if you selected both B3 and B4 at the same time, the code will get confused and not trigger either event! 😵 Glad it worked 😊 Caleeco
  5. 1 point
    Hello Ziya Good to see you again. That's an awesome idea! Certainly something we can use the SelectionChange Event to implement. Try this code out and see if it does what you need. Obviously you'll need to align your charts up first & past the code in the relevant SHEET object and not a VBA module. Private Sub Worksheet_SelectionChange(ByVal Target As Range) '//--- Source: www.ExcelWTF.com '//--- Purpose: Quick Switch between charts If Target.Count > 1 Or Intersect(Target, Range("B3:B4")) Is Nothing Then Exit Sub If Target.Address = "$B$3" Then ActiveSheet.Shapes("Chart 1").ZOrder msoBringToFront If Target.Address = "$B$4" Then ActiveSheet.Shapes("Chart 2").ZOrder msoBringToFront End Sub Hope That Helps Caleeco 😎
  6. 1 point
    Hey Cal, Just checked out your other side... looks pretty slick I will be browsing! Hopefully I'll be less of a Excel Newbie soon enough Z
  7. 1 point
    Hi Caleeco, you rock man !!! I can't test the printing yet (next week), but the rest is exactly what I need. 1) Indeed the time stamp, very important! I assume this is the code you will use after the pdf or word is saved : .Range("Z" & CustRow).Value = TemplName .Range("AA" & CustRow).Value = Now 2) Printer I will test next week 3) I simply would say "Kill (wordFilename)" and "Kill (pdfFilename)" somewhere at the end :-) 4) Only code for closing Word, not Outlook, because I always have to review before I definitely send. So the email must be ready to send, and not immediately, so please set it on ".Display" . And Outlook is always running on my pc, so no need to close that. 5) I tested the outmail.send and works like a charm, but as said, must be set to .display 6) When you tidy up, can you adjust the variables for print/email and pdf/word. I didn't realize those 2 are just the headers for making a choice, so it's either print or email, and either word or pdf, so no doubles. Sorry for missing that earlier. This simplifies the code a bit. Again sorry !! Can you also put in this code when you are going to open Word ? On Error Resume Next Set WordApp = GetObject("Word.Application") If Err.Number <> 0 Then Err.Clear Just to avoid problems when Word already running. Probably not...but just to be sure :-) Thanks again !!! Sapron
  8. 1 point
    Greetings, I have a report ran for me which dumps into a .xls into several different sections. Each section has a name in column B, a route in the following row in column C, and data that begins to dump in the next row Columns D through F which are time planned, time actual, and location. Each section goes about 200 +/- rows of these times and locations. After each section, there are about 5 blank rows before the next name and route section information. I got a friend to help me with a macro to count each time a certain timed event happens. These Counts occur in columns H, I , and J. One count is for early, one count for late, and one count for each stop. But now I want to add up the number of times it happens for each name and route. I am using SUM function to add up each section. The total is in the same row as the Route. I have learned about the INDEX to Next Blank, but am not sure how to write the macro for the formula to go instead of the SUM function I am typing in each cell. I want to continue this report to run and sum up each section (for each driver and route that day). B C D E F H I J K John Doe Early Late Stops Pct Route 1 1 3 5 20.00% 10:00 AM 10:01 AM 123 Main Street 1 1 10:15 AM 10:14 AM 246 Main Street 1 1 10:30 AM 10:30 AM 123 3rd Avenue 1 10:45 AM 10:50 AM 247 3rd Avenue 1 1 11:00 AM 11:10 AM 395 3rd Avenue 1 1 About Five Lines of Blank Rows Jane Done Early Late Stops Pct Route 2 2 1 5 40.00% 10:00 AM 10:01 AM 100 Cherry St 1 1 10:15 AM 10:14 AM 210 Cherry St 1 1 10:30 AM 10:30 AM 330 Cherry St 1 10:45 AM 10:44 AM 1000 3rd Avenue 1 1 11:00 AM 11:00 AM 1100 3rd Avenue 1 Thanks in advance for all help.
  9. 1 point
    File sent earlier today. Thank you in advance!
  10. 1 point
    I think you are on the right track :-) Thanks so far and looking forward to see it running perfectly. If you have questions please let me know !
  11. 1 point
    Thank you Caleeco! I will give it a try and let you know!
  12. 1 point
    Recieved! Thanks for the source files, I will get started on this now.. hopefully I can crack it this evening and report back Caleeco
  13. 1 point
    Hi Caleeco, thank you for your answer. That wouldn't be an option, because the recipient can alter the data afterwards in excel and that's just the issue. For audit purposes the data must be data which can not be altered afterwards. So we will leave it like it is..no password thusfar, thank you for your input though !!
  14. 1 point
    Hi, I'm busy with converting excel files to pdf and send them out with Outlook. The converting is okay, but I want to add a password protection. The password will be a general one, so it doesn't have to put in manually each time the excel file will be converted. Can you help me with this. This is a part of the vba code : If .Range("F2").Value = "PDF" Then FileName = ThisWorkbook.Path & "\" & .Range("C" & CustRow).Value & " " & .Range("G" & CustRow).Value & ".pdf" 'creeert file met persnr en achternaam WordDoc.ExportAsFixedFormat OutputFileName:=FileName, ExportFormat:=wdExportFormatPDF WordDoc.Close False Else 'Als het in Word moet FileName = ThisWorkbook.Path & "\" & .Range("C" & CustRow).Value & " " & .Range("G" & CustRow).Value & ".docx" WordDoc.SaveAs FileName End If If .Range("J2").Value = "Email" Then Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.Createitem(0) With OutMail .To = Blad16.Range("U" & CustRow).Value .Subject = "Beste " & Blad16.Range("E" & CustRow).Value & "ADV en ziek" .Body = "Beste " & Blad16.Range("E" & CustRow).Value & "Hier de brief mbt adv en ziek" .Attachments.Add FileName .Display 'Als je zonder van tevoren wilt zien dan .Display to.Send End With Else: WordDoc.PrintOut WordDoc.Close End If Kill (FileName) 'Gooit de pdf of word document weg wat je hebt aangemaakt Can you help me with this one ? Thanks Ron
  15. 1 point
    Hey Kirabo, I thought that may have been the case! It's always a good idea to rename your charts however, as this makes things easier when modifying them via VBA. You can make use of the CEILING function to round up to the nearest 10, and I have modified the code slightly to just look at the entire columns of B:C. Sub ChangeAxisScales_1Line() '// Source: www.ExcelWTF.com '// Purpose: Set Max Y-Axis using MAX of 2 x datasets Dim Max1 As Long, Max2 As Long Dim ws As Worksheet Set ws = Sheets("Utilization") With ws Max1 = WorksheetFunction.Max(.Range("B:B")) Max2 = WorksheetFunction.Max(.Range("C:C")) If Max1 > Max2 Then ' Change the chart names below! .ChartObjects("Chart1").Chart.Axes(xlValue).MaximumScale = WorksheetFunction.Ceiling(Max1, 10) .ChartObjects("Chart2").Chart.Axes(xlValue).MaximumScale = WorksheetFunction.Ceiling(Max1, 10) Else .ChartObjects("Chart1").Chart.Axes(xlValue).MaximumScale = WorksheetFunction.Ceiling(Max2, 10) .ChartObjects("Chart2").Chart.Axes(xlValue).MaximumScale = WorksheetFunction.Ceiling(Max2, 10) End If End With End Sub Give it a try and let me know how you get on Thanks Caleeco
  16. 1 point
    haha turns out my charts ARE called Chart1 & Chart2 anyway That's cool, seems to work great! However, is it possible to change it so that the axis find the biggest number in my dataset and then rounds up to the nearest 10? Also how can i change it so that columns B:C can be dynamically filled with more data and I wont have to keep editing the code?
  17. 1 point
    Hey Kirabo, If you are using Excel 2013 or greater, you can just click on the chart and then the Chart Name will be displayed in the Top Left of the screen (Next to the formula bar). You can then edit the code below to suit, in my example i have called them 'Chart1' and 'Chart2'. Sub ChangeAxisScales_1Line() '// Source: www.ExcelWTF.com '// Purpose: Set Max Y-Axis using MAX of 2 x datasets Dim Max1 As Long, Max2 As Long Dim ws As Worksheet Set ws = Sheets("Utilization") With ws Max1 = WorksheetFunction.Max(.Range("B2:B8")) Max2 = WorksheetFunction.Max(.Range("C2:C15")) If Max1 > Max2 Then ' Change the chart names below! .ChartObjects("Chart1").Chart.Axes(xlValue).MaximumScale = Max1 .ChartObjects("Chart2").Chart.Axes(xlValue).MaximumScale = Max1 Else .ChartObjects("Chart1").Chart.Axes(xlValue).MaximumScale = Max2 .ChartObjects("Chart2").Chart.Axes(xlValue).MaximumScale = Max2 End If End With End Sub Let me know how you get on Thanks Caleeco
  18. 1 point
    Hi Caleeco Looks like you've been having it pretty easy with me not pestering you with my problems. However, I have a new problem. Still on the same spreadsheet as previous, but a little enhancement has stopped working. I've been using =LOOKUP(2,1/(1-ISBLANK(S:S)),S:S) to find the last value in a column that consists of blanks and manually entered numbers. It worked fine until I decided to use a formula to automatically enter new values in the column instead of me entering them manually. There are now about a hundred blank cells in the lower section of the column, each with an underlying formula. Now my =LOOKUP cell is blank; presumably it's showing the value of the last formula in the column - a blank. How do I resolve this? I searched the 'net and tried an assortment of similar formulae, but nothing worked. Now I need proper help. As always, I'm open to using a formula or VBA, whichever is the more efficient. Many thanks.
  19. 1 point
    Hi Caleeco For a "stab in the dark", that was pretty well aimed! As expected, it works perfectly - but I've learned by now to expect nothing less Thank you so much for that, now the sheet is performing as normal again. I'll try to come up with something that taxes your brain a bit better next time. Cheers
  20. 1 point
    Hi Caleeco I think it must be time I considered another system upgrade; my unit took 36 seconds to run the code. You're right though - it's astounding how much faster this code runs than the initial version. Can't match 6 seconds though! That was the good news. The not so good news is that the output is rather interesting. On the first run, it filled the four columns on the first sheet but nothing on the second sheet. Then, when I looked at the output on the first sheet, I couldn't match it to the horizontal data. I then ran the code on the second sheet. The output was fine - it matched the horizontal data - but then I noticed that the output extended way below the rows of data. I then ran a series of run the code, delete the output, run it on the other sheet, delete the output, until I finally nutted out what I believe is happening: When I run the code from the first sheet (the h12Data sheet) it initially, correctly, transfers the h12 data from horizontal to vertical, but then when it moves to the D1 sheet it transfers that horizontal data and prints it on the h12 sheet, overwriting the initial values. That's why, when I first looked at the top of the h12 page, the values in the columns were wrong. When I scroll lower on the sheet, to below row 1840, the column values are correct because down there they've not been overwritten. That also accounts for why the columns on the second sheet were blank. When I delete the transferred values, to give me empty columns again, and then run the code on the second sheet, a similar thing happens. This time the transferred values are correct because the code executes in a fixed sequence; firstly the h12 data is written to J, K, N & O, then the D1 data overwrites it, and since I'm now on the D1 sheet the transferred values match the horizontal data. And then, when I scroll down the sheet, there, below the rows of D1 data, are the values that have been transferred from the h12 sheet. A consequence of this is that I have to run the code from the h12 sheet, not from the D1 sheet, so I've deleted the Update button from the D1 sheet to mitigate a potential lapse of memory. So from my reading it's a pretty simple fix - (simple for you, that is; impossible for me!) - just tweak the code so that when it reads the D1sheet it prints the values to the D1 sheet, not to the h12 sheet. I've also noticed that even once the data transfer is complete, the code still appears to be running in the background. When I run the code I can "hear" the load that has been put on the CPU as there is a distinct change in the frequency of the cooling system fan/pump. Later, when I delete the values in col J, K, N and O, there is the same change in frequency from the cooling system. I would not have expected to hear any change when I simply delete cell contents; iIt's as though it's mother hen, watching over her chicks, and making noise because I've destroyed them. Also, for what it may be worth, I notice that the last block where values should have been written but aren't, is highlighted as if I'd just run a copy/paste. Hope that diagnosis is of some help.
  21. 1 point
    Hi Caleeco It took me a little while to get my head around what you were proposing - even with starting at 0430 hr this morning, when I was supposedly bright-eyed and bushy-tailed! - but I eventually saw what you were thinking. And, as I should have anticipated, it works a treat! I've spent the day making use of the new code. I've also done a lengthy but badly needed re-vamp of my main worksheet. Previously, using my manual system, it typically took me about three days to cover a year of back-testing. Today I've covered eight years! A month's work completed in a day! And better, I'm not brain-dead as I used to be with the previous method. I'd put more beers here but I don't want you getting drunk! Once again - grateful thanks for all your help.
  22. 1 point
    And another one bites the dust!! Well done, that solved it. The errant date + time has now disappeared off the worksheet, and presumably from every other location in the workbook that these annoying, invisible gremlins were lurking. I suspect that one of the comments in the MSDN thread had it nailed. My routine practice, given the complexity of these worksheets, is to spend time developing code in a small section of the sheet. Once I get it fully functional then I copy that block down, or across, the sheet. Once I've proven that sheet, then I clone it and make new, fully operational sheets. The suggestion from MSDN was that the problem you've just resolved is not an issue with my existing formulae, but with the output of a previous formula from a previous iteration of the sheet that resulted in a null, or #N/A, or #DIV0, or whatever that lurks unseen beneath the apparently blank cell, waiting to cause havoc. The new coding should fully take care of this though and I'm making up a schedule/check list that will ensure that each time I open up an existing workbook I run DoIt to purge the book of these vermin! Thanks again. I'll now re-mark it as Solved
  23. 1 point
    Hi Caleeco Here's the new issue that I referred to last night. I have also emailed to you a sample worksheet so that the following notes make some sense. The sample worksheet, with some fairly old data, illustrates my problem. Column O interogates the data in columns D - G and returns a value when conditions are true. That value then triggers columns Q - V. There is one time interval between each of the columns Q - V; on this sheet the time interval is 12 hr (col C). I'm only interested in cells in col R - V that return either RV or FO; (you'll note from the underlying formula that col Q will only ever return LC or Not LC). The occurrences of RV and FO then have to be copied to their corresponding cell in col H - for which I'd appreciate some masterful VBA. I've manually transferred the values to col H to illustrate the desired end output. In essence it's a case of reading horizontally across col R - V and writing the RV and FO values, if any, vertically down col H. You can probably see that the cell in col Q of any given row corresponds to the cell in col H of that row. I've colour coded one set of cells to make the equivalence more obvious. A potential source of error is that if the "SH" occurrences are close enough together, more than one cell from col R - V will try to copy to col H. You can see from the sheet with the arrows on it that there are three examples of this in the lower area. The rules here are that: a) An RV adding to an RV copied from a preceding row remains as an RV; b) An RV adding to an FO copied from a preceding row remains as an FO; c) An FO adding to an RV copied from a preceding row replaces the RV; and d) An FO adding to an FO copied from a preceding row remains as an FO. Hope that is all clear; really looking forward to the outcome as this little issue is currently a major stumbling block with advancing the further development of the worksheet. And hey! Did you notice? There's not one cell on either worksheet that displays as a blank but has something hidden, lurking beneath the surface. Progress!! And while I'm on this topic, the lesson learned with the previous problem is: Only copy VBA code from the forum; do NOT copy it from the emailed notification (because it puts line breaks in that shouldn't be there!). Any other forum users reading this - take note!
  24. 1 point
    Hi Caleeco WtF??? We're there! After sorting a couple of minor hiccups, we have fait accompli!!! First minor issue was that the second sub-routine was calling the wrong function. You'd simply forgotten to update the function name, so I fixed that readily enough. The second issue, and there were two instances of it, was that the new coding was writing FO to col I and M one row above where the same FO had been written in col H and L. An FO occurring, for example, in SL +2 was writing in col M to the SL +1 position. That too had a nice easy fix - I simply added in two new, blank columns, 1 in each block, to push the ocurrences down by 1 row. I've emailed you a copy of the updated workbook so you can see the changes and the end result. The final embellishment was to combine the 4 x sub-routines into one, and then assign the new sub to an 'Update' button on the worksheet. To put your work of art into practice, all I have to do now is enter new blocks of data into col B - G, hit 'Update', then make use of the output from col H - O. Caleeco, thank you so, so much for your time and your skills. It has taken me a year of back-testing to derive what, to you, must look like an incomprehensible assortment and inter-relationship of meaningless symbols. Following the same manual procedure as used last year, the back-testing that I still have ahead of me would also have taken about a year - maybe more. I still have some fine-tuning to complete on the main worksheet but once that's complete - hopefully over the weekend - I anticipate the testing to now require no more than a month. Brilliant!! The above are extremely well-deserved. Maybe one day I'll get the opportunity to convert them into real, live, cold and wet ones. Best wishes and grateful thanks from a very satisfied OldFella
  25. 1 point
    Hi Caleeco Second impressions - exactly the same as the first impressions - brilliant! One feature of my worksheets is that at this stage of their development they don't stand still. What you see today is unlikely to be what you see tomorrow. In line with this, the sample worksheet I sent you is already obsolete. Don't worry, all I've done is add in a few more columns. I modified your coding and changed the column letters and it all still functions as intended. I've also added in a second block of formulae that performs a similar task to the first block. I'll email you a revised sheet so you can see what I've done. I then created a second block of your coding, adapted it to match these new columns, and it too runs as intended. The amended coding, and the new coding, are with the emailed worksheet - hopefully! I'll leave it up to you whether you wish to extend the coding so that the helper columns are eliminated; from my perspective it's not important. This worksheet is actually just an intermediate step in the process; the main sheet accesses the values in col H - O using Index/Match based on date and time, so the appearance of this sheet is not critical. However - if you want the challenge of streamlining it, and especially if it improves the overall efficiency, then I'm more than happy to incorporate the upgrade. I would appreciate one minor change though. When an SH or SL value occurs within the last few rows of data the coding continues to write FO/RV values below the last row of data. You'll see what I mean when you look at the emailed sheet. Can you please modify the coding so that it ceases writing FO or RV values below the last row of data. I'm now going to spend a few days very carefully testing the coding. You'll see on the worksheet that there are two columns headed cT FO. These columns will display externally sourced FO values. I'm having some difficulty with the accuracy of the external input and I'm hoping that your coding will pick up all the instances of FO situations that the external source ought to determine - but doesn't. My gut feeling is that it won't pick them up and if that proves to be the case then I may come back to see if you can somehow develop code to pick them up. If you thrive on challenges, this will be one!! I'm currently endeavouring also to get correct results from the external data; if successful, that will negate the need for your challenge. Thanks once again for bringing it this far forward.
  26. 1 point
    Hi Caleeco First impressions - beautiful to watch! When I hit the FO-RV button and watch the symbols start appearing down col H, it's all I can do not to wet myself! I'm going to give it a bit more extensive testing but based on what I just watched I don't anticipate any problems. If all is well then I'll get back to you, hopefully later today, with the next step. Definitely a beer owing from this one!
  27. 1 point
    Sorry for the delay - I finally got around to amending the code and running it. I'm delighted to say that the outcome is stunning. It purged a 22-sheet workbook in about 15 seconds. I then ran Ctrl-G / Blanks and was horrified with what I saw. I had regularly been finding cells on the various worksheets that weren't responding as they should, or that formulae were missing from odd cells. Using your code, followed by Ctrl-G, I can now see exactly where the problems are and can resolve them. Brilliant!! That's one beer I owe you! I'm now going to sit here and draft up your next beer-earning exercise. It's convoluted, as you'll eventually see, so it's going to take me a while to very carefully outline what I'm trying to achieve. Probably won't complete it tonight so don't hold your breath. Thanks again for sorting this current issue.
  28. 1 point
    haha I enjoy problem solving with VBA so keep them coming Yes we could do that, but it would need a slight change. The original code looks at the list items top to bottom... but if we start removing items, the counter in our loop will cause the code to break Luckily we can just start at the end of the list and step backwards Private Sub btnTransfer_Click() '//Source: www.ExcelWTF.com '//Purpose: Move Selection from List1 to List2. Deletes item from List1 Dim i As Long For i = (ListBox1.ListCount - 1) To 0 Step -1 If ListBox1.Selected(i) Then ListBox2.AddItem ListBox1.List(i, 0), 0 ListBox1.RemoveItem i End If Next End Sub Hope that helps Caleeco
  29. 1 point
    Hmm, not done that before... but had a crack at it! Assumed your second Listbox is called 'Listbox2' Private Sub btnTransfer_Click() '//Source: www.ExcelWTF.com '//Purpose: Move Selection from List1 to List2. Clears selection each time. Dim i As Long ListBox2.Clear 'Delete this line if you wish to transfer multiple selections For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then ListBox2.AddItem ListBox1.List(i, 0) End If Next End Sub Please try the code above. Also please note the Listbox2.Clear, this will reset the contents each time the button is clicked. Delete that line if that isnt the intended use case Hope that helps Caleeco
  30. 1 point
    Hey Hey Thanks! No problemo, see answers below Alphabetic "Data" Just the defaults "Userform1" & "Listbox1" Thank you Z
  31. 1 point
    Hey Ziya, Good to see you back on the forum! Yes, that shouldn't be too difficult. Some questions for you: Is this an alphabetic or numeric sort? What is the sheet name with the data? What are the assigned names for your Userform and Listbox (Check the Properties window in the VBEditor) Let me know Caleeco
  32. 1 point
    Hi David, Glad you liked the CF solution! Yes, with the spreadsheets I build; I always go for simplicity. As much as I enjoy writing code, VBA isn't always the best answer Excel has lots of in-built tools we can take advantage of! CF is very robust, so many things you can use it for! Ok sounds good, let me know if the colours don't change correctly (I did some testing on my sheet which seemed to work). Haha, yes when dealing with big spreadsheets... efficiency savings are key! Glad I could help Caleeco
  33. 1 point
    Hi Caleeco Re the conditional formatting option - of course! Such an elegantly, simple fix. In all my years of Exceling I've never used that aspect of conditional formatting, so I never even considered it. I use conditional formatting regularly, but always for something either date related or formula based. Brilliant! I've applied it to one worksheet so far and it appears to work perfectly. I'll now look for a sheet where I can add some data that will cause the ranking to change, so I can verify that the colours change correctly. I'll get back to you if I have any problem. Given the elegance of that solution I'll skip VBA. I also don't need additional drain on computation resources, I've already got enough on the spreadsheet that gives a noticeable drop in cooling fan speed! Job done - now you can go back to your website. Many thanks David
  34. 1 point
    I apologize, I thought I had responded to this yesterday, everything seems to be working great. I've tested the tool out a few times and it does exactly what I need. All I need to do is tidy up some of my formulas and figure out why the players and their Tm/Bye scramble on each sort. Thanks for your help and thanks for adding the comments to the code!
  35. 1 point
    Hi Ryan, Sorry for the delay, took me some time to type out all the extra comments! Hopefully they should explain most of the code. If you need any further clarification let me know! Please see new file below (the old one had a mistake in the code, and may have deleted data it shouldnt have!) https://ufile.io/pn1sb So i think this new code below should work for you: Code: Sub PlayerDraft() 'Source: www.ExcelWTF.com '// Declare variables Dim shOverall As Worksheet, Sht As Worksheet Dim lrO As Long, lrPos As Long, PlayerRow As Long Dim rPos As Long, colFantPt As Long, colX As Long Dim Player As String, Position As String Set shOverall = Sheets("Overall") Dim Chk As CheckBox Application.ScreenUpdating = False '// Main Code 'Find last used row on the 'Overall' sheet lrO = shOverall.Range("B" & Rows.Count).End(xlUp).Row 'Find out if the check box clicked is on or off (1 or 0) Set Chk = Sheets("Overall").CheckBoxes(Application.Caller) 'If the checkbox clicked is 1 If Chk = 1 Then 'Check the row the Check box is on PlayerRow = Chk.TopLeftCell.Row 'Find Players Name by looking in adjacent column B of that row Player = shOverall.Range("B" & PlayerRow).Value 'Find the players position (RB, WR, QB etc) and create a reference to that sheet Set Sht = Sheets(Range("C" & PlayerRow).Value) With Sht 'Find the last used row of the Position sheet lrPos = Sht.Range("C" & Rows.Count).End(xlUp).Row 'Find the row the Player is on the Position sheet rPos = .Range("C2:C" & lrPos).Find(Player).Row 'On the position sheet, find the column number for the 'FantPt' Column colFantPt = .Rows(1).Find("FantPt").Column 'On the position sheet, find the column number for the 'X-Factor' Column colX = .Rows(1).Find("X-Factor").Column 'Clear the FantPt value for the player on the Position sheet .Cells(rPos, colFantPt).ClearContents 'Clear any exisitng filters .AutoFilter.Sort.SortFields.Clear 'Sort the 'X-Factor' column on the Position sheet .AutoFilter.Sort.SortFields.Add Key:=.Range( _ .Cells(1, colX), .Cells(lrPos, colX)), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ xlSortNormal With .AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .Apply End With End With 'Go back to the 'Overall' Sheet and sort on column G With shOverall .AutoFilter.Sort.SortFields.Clear .AutoFilter.Sort.SortFields.Add Key:= _ Range("G1:G" & lrO), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _ :=xlSortNormal With .AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .Apply End With End With End If Application.ScreenUpdating = True End Sub Bearing in mind that the SETBOX code, only needs to be run once (which I have done on the attached sheet)... so you shouldnt have to do it again. Code: Sub SetBox() 'Source: www.ExcelWTF.com ' This code only needs to be run once ' It will set each checkbox to run the PlayerDraft Macro when clicked Dim chkBx As CheckBox For Each chkBx In Sheets("Overall").CheckBoxes chkBx.OnAction = "PlayerDraft" Next End Sub Let me know if it works on your end, Cheers Caleeco
  36. 1 point
    Hi Cal, I'm back I see you have re-modelled your previous re-model! The new website is looking amazing! Still I see no new emotes hopefully its on your list of thing to add. Got a few more VBA Q's, will post them up soon Z
  37. 1 point
    Hi Ryan, Ok cool, thanks for the clarification. I'll draft some code up for you to test in a moment. Thanks! Caleeco
  38. 1 point
    Hi Ziya, No problem, I'm happy to help! With regard to the alignment , each cell has an INDENT property we can make use of. So towards the bottom of the code please edit this WITH statement: Code: With shLabel.Columns("A:C") .ClearContents .VerticalAlignment = xlVAlignCenter .IndentLevel = 5 End With Change the INDENT LEVEL to suit your requirement. Aha, you're half right there. The variable Label is a string, but it is an ARRAY of strings. As declared at the start, the parenthesis are the clue to knowing its an ARRAY rather than a variable. Code: Dim Label() As String You can think of an array like a table of data, the size of the table can be whatever you like. In this instance, i changed the size of the array to match how many rows of data we had (adjusting -1 to account for the fact the data starts in row 2). Code: lr = shYear.Range("I" & Rows.Count).End(xlUp).Row 'Find the last used rowReDim Label(lr - 1) 'Set the size of the array Each row of an ARRAY is called an ELEMENT. So i created a loop, to fill each ELEMENT with 1 address from your 2017 sheet If you would like a more in depth explanation I would be happy to talk you through it. However, I will be starting a blog on the website very soon to teach people this sort of thing Caleeco
  39. 1 point
    Thanks for the additional information. I have put some code together for you to test! Note: The Option Base 1 statement must appear at the top of your code Code: Option Explicit Option Base 1 Sub CreateLabels() 'Source: www.ExcelWTF.com 'Purpose: To create address labels using data from excel sheet '----- Variables Dim shYear As Worksheet, shLabel As Worksheet Dim lr As Long, i As Long, j As Long, k As Long Dim Label() As String Dim r As Range, RNG As Range '----- Code i = 1 Set shYear = Sheets("2017") 'Change the line below next year if you create a new sheet lr = shYear.Range("I" & Rows.Count).End(xlUp).Row 'Find the last used row ReDim Label(lr - 1) 'Set the size of the array Set RNG = shYear.Range("F2:F" & lr) 'Set the data range to loop through Application.ScreenUpdating = False On Error Resume Next For Each r In RNG 'Collate information in the array If Not IsEmpty(r.Value) Then Label(i) = Label(i) & r.Value & " " 'Title If Not IsEmpty(r.Offset(0, 1).Value) Then Label(i) = Label(i) & r.Offset(0, 1).Value & " " 'Initial If Not IsEmpty(r.Offset(0, 3).Value) Then Label(i) = Label(i) & r.Offset(0, 3).Value & vbCrLf 'Surname If Not IsEmpty(r.Offset(0, 4).Value) Then Label(i) = Label(i) & r.Offset(0, 4).Value & vbCrLf 'Add 1 If Not IsEmpty(r.Offset(0, 5).Value) Then Label(i) = Label(i) & r.Offset(0, 5).Value & vbCrLf 'Add 2 If Not IsEmpty(r.Offset(0, 6).Value) Then Label(i) = Label(i) & r.Offset(0, 6).Value & vbCrLf 'Add 3 If Not IsEmpty(r.Offset(0, 7).Value) Then Label(i) = Label(i) & r.Offset(0, 7).Value & vbCrLf 'Add 4 If Not IsEmpty(r.Offset(0, 8).Value) Then Label(i) = Label(i) & r.Offset(0, 8).Value & vbCrLf 'Add 5 If Not IsEmpty(r.Offset(0, 9).Value) Then Label(i) = Label(i) & r.Offset(0, 9).Value & vbCrLf 'Add 6 If Not IsEmpty(r.Offset(0, 10).Value) Then Label(i) = Label(i) & r.Offset(0, 10).Value 'PostCode 'Debug.Print Label(i) i = i + 1 Next r 'Print the data to the labels sheet Set shLabel = Sheets("Labels") With shLabel.Columns("A:C") .ClearContents .VerticalAlignment = xlVAlignCenter End With j = 1 k = 1 For i = LBound(Label) To UBound(Label) shLabel.Cells(j, k).Value = Label(i) If k = 1 Then k = 3 ElseIf k = 3 Then k = 1 j = j + 1 End If Next Application.ScreenUpdating = True End Sub Let me know how you get on Thanks Caleeco
  40. 1 point
    Hi Reso, Sure thing, that's just a small edit. Add the following snippet before the last line (where the location is printed to the dashboard) Code: If Found = False Then MsgBox "Part Number " & PartNo & " not found in either dataset", vbCritical, "Error" Exit Sub End If Hope that helps Caleeco
  41. 1 point
    Hello, Came over from another well known Excel Forum, Nice website Caleeco! Looks pretty slick. I'll be sure to post my next VBA query over here, should be fairly soon lol, working on some coding at the moment Reso
  42. 1 point
    Hi Reso, Thanks for the additional information. Apologies for the delay in getting back to you, upgrading websites can be very time consuming Give this code a spin and let me know if it works on your end: Code: Sub FindPart() 'Source: www.ExcelWTF.com 'Purpose: To locate part number and list found location '----Variables Dim PartNo As String, Location As String Dim ws As Worksheet, wsDash As Worksheet, wsSAP As Worksheet, wsUser As Worksheet Dim c As Range Dim lr As Long Dim Found As Boolean '----Code Set wsDash = Sheets("Dashboard") Set wsSAP = Sheets("SAP Data") Set wsUser = Sheets("User Input") 'Set the PartNo to search for PartNo = wsDash.Range("A4") 'Search for the Part Number, setting a dynamic range in column C of SAP DATA lr = wsSAP.Range("C" & Rows.Count).End(xlUp).Row Set c = wsSAP.Range("C2:C" & lr).Find(PartNo, , xlValues, xlWhole, xlByRows, , True) If Not c Is Nothing Then Location = wsSAP.Name & " - " & c.Address(0, 0) Found = True End If 'Search for the Part Number, setting a dynamic range in column C of User Input lr = wsUser.Range("C" & Rows.Count).End(xlUp).Row Set c = wsUser.Range("C2:C" & lr).Find(PartNo, , xlValues, xlWhole, xlByRows, , True) If Not c Is Nothing Then If Found = True Then MsgBox "Part Number " & PartNo & " was found on both sheets. Exiting macro...", vbCritical, "Error" Else Location = wsUser.Name & " - " & c.Address(0, 0) End If End If 'Print location to Dashboard sheet wsDash.Range("D4").Value = Location End Sub Thanks Caleeco
  43. 1 point
    The new website looks great, certainly an upgrade! More emoticons would be nice I could do with some more confused ones... as that's my expression most of the time when using VBA Z
  44. 1 point
    Website looks awesome! Clean design, the logos are awesome! Not much to add, looks like your list of scheduled improvements should cover it
  45. 1 point
    hehe yes, thankfully each batch size of data is the same so we can avoid having a SELECT CASE or IF statement Sorry, my mistake! Totally forgot about the coloured cell. I've added a few more lines of code in the main IF statement to cover that. Hopefully light blue fits your colour scheme. Code: Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Source: www.ExcelWTF.com 'Purpose: Auto-hide columns based on cell selection '---- Variables Dim r As Long '---- Code 'Exit Sub if more than one cell is selected or data is deleted If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub 'If selection is in the 'Product Range' If Not Intersect(Target, Range("A2:A11")) Is Nothing Then r = ActiveCell.Row 'Determine the current row number ActiveSheet.Range("A2:A11").Interior.ColorIndex = 0 ' Clear Colours ActiveSheet.Range("A" & r).Interior.ColorIndex = 37 'Colour the correct cell Columns("B:AY").EntireColumn.Hidden = True 'Hide all columns 'The code below works out the Starting column number for each batch of data If r > 2 Then r = 2 + (r - 2) * 5 'Unhide the data in column r and the next 4 columns Range(Columns(r), Columns(r + 4)).EntireColumn.Hidden = False End If End Sub Thanks, Caleeco
  46. 1 point
    Wait... what!? LOL I was expecting some sort of 10 level IF Statement, but that equation to find the starting column is genius... i wouldn't have thought of that! Code works great! However, the selected cell doesnt appear to turn blue when I choose a product. Do I need to add conditional formatting or something? Z
  47. 1 point
    Hi Ziya, Thanks for the question, it turned out to be an interesting one to solve! I see you've read something about Worksheet_Change events, you're correct in thinking that's what we need to use! Please post the following code in the SHEET CODE (Not a module or 'ThisWorkbook') specific to the sheet you wish to run the marco. Code: Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Source: www.ExcelWTF.com 'Purpose: Auto-hide columns based on cell selection '---- Variables Dim r As Long '---- Code 'Exit Sub if more than one cell is selected or data is deleted If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub 'If selection is in the 'Product Range' If Not Intersect(Target, Range("A2:A11")) Is Nothing Then r = ActiveCell.Row 'Determine the current row number Columns("B:AY").EntireColumn.Hidden = True 'Hide all columns 'The code below works out the Starting column number for each batch of data If r > 2 Then r = 2 + (r - 2) * 5 'Unhide the data in column r and the next 4 columns Range(Columns(r), Columns(r + 4)).EntireColumn.Hidden = False End If End Sub Let me know how you get on Thanks Caleeco
  48. 1 point
    Hi Guys Nice site Caleeco I am looking for a VBA to copy the values from one workbook to another based on the column headings, sample data attached. The "Conversion_Sheet" has the data that I want to copy to the "Import_Sheet". The "Conversion_Sheet" has to contain the VBA code as the "Import_Sheet" has to be saved as xls to be imported. The column headings are constantly changing and there could be anything between 2 columns to 200. Additionally there could be 1000s of rows. Any help as always will be a great help. Thanks Dougie Conversion_Sheet.xlsm Import_Sheet.xlsx
  49. 1 point
    Hi Dougie! Welcome to the forum, I'm glad you decided to sign up Thank you, I'm still making some design improvements/modification but I'm nearly there! I will take a look at the sample sheets you have provided and get back to you with some code to try Many Thanks Caleeco
  50. 1 point
    Hi Geeperz, Apologies, I dont know why it stripped out that syntax! New board...got a few things to fix! I just tested the code below, and it works on my end. The Code you uploaded wasnt working as the loop statement should be Loop While rFound.Address FirstAddress Working code: Sub TransposeData2() Application.ScreenUpdating = False Dim rFound As Range Dim FirstAddress As String Dim lC As Long 'Count variable for the rows lC = 0 Worksheets("Combine Sheet").Activate With Worksheets("Combine Sheet").Columns("C:C") Set rFound = .Find(What:="Make", After:=Range("C" & Rows.Count), LookIn:=xlValues, _ lookat:=xlWhole, Searchorder:=xlByRows, Searchdirection:=xlNext, MatchCase:=False) If Not rFound Is Nothing Then 'Value has been found FirstAddress = rFound.Address lC = Worksheets("Extract").Range("A" & Rows.Count).End(xlUp).Row Do rFound.Select 'Add post processing If rFound.Offset(0, 1) = vbNullString Then 'There is some data missing Range(rFound.Offset(1, 1), rFound.Offset(1, 1).End(xlDown)).Copy Worksheets("Extract").Range("A" & lC).Offset(1, 1).PasteSpecial Paste:=xlValues, Transpose:=True lC = lC + 1 Else Range(rFound.Offset(0, 1), rFound.Offset(0, 1).End(xlDown)).Copy Worksheets("Extract").Range("A" & lC).Offset(1, 0).PasteSpecial Paste:=xlValues, Transpose:=True lC = lC + 1 End If Set rFound = .FindNext(After:=rFound) Loop While rFound.Address FirstAddress Else 'Value has NOT been found Exit Sub End If End With Application.CutCopyMode = False Application.ScreenUpdating = False End Sub Thanks for your patience Regards Caleeco
  • Create New...