User Profile
NikolinoDE
Platinum Contributor
Joined Jul 08, 2020
User Widgets
Recent Discussions
Re: Excel White\Blank Screen
Since I am not aware of any official information about a bug, please try the following solution approaches which may resolve your issue. Based on your scenario (multiple files affected), here's the optimal sequence: Disable Hardware Graphics Acceleration How to do it without seeing the screen: Close Excel completely. Open a blank Excel file ( it will be white). Press the Alt key on your keyboard. You should see letters appear over the ribbon tabs (File, Home, Insert, etc.). Press F (for File). Press T (for Options - it's usually at the bottom). If you don't see the menu, press Alt again to make the letters appear, then press O. Once the Options window opens (you might have to guess where the "OK" button is or press Enter): Press the Tab key repeatedly until you highlight the list on the left. Use the Down Arrow key until you hear "Advanced" (or feel for the scrollbar moving). Press Enter. Press Tab until you get to the main content area. Use the Down Arrow key until you find the section labeled Display. Look for the checkbox: "Disable hardware graphics acceleration". Press the Spacebar to check it. Press Tab until you find the OK button and press Enter. Close Excel and reopen it. Open in Safe Mode (To check for Add-ins) If disabling graphics didn't work, a plugin (Add-in) is likely crashing Excel upon launch. Close Excel. Press Windows Key + R on your keyboard. Type exactly: excel /safe Press Enter. If Excel opens normally (with color): Go to File > Options > Add-ins. At the bottom, where it says "Manage: Excel Add-ins", click Go... Uncheck ALL boxes and click OK. Restart Excel normally. If it works, turn the add-ins back on one by one to find the bad one. Printer Driver Excel tries to format the page based on your default printer. If your default printer is a network printer that is offline, or a "PDF" writer that is broken, Excel renders a white screen. Press Windows Key + R, type control printers, and hit Enter. Find a generic printer like "Microsoft Print to PDF" or "Microsoft XPS Document Writer". Right-click it and select "Set as default printer". Try opening Excel again. Reset the Excel Registry Key If the above fails, the internal settings file for Excel is corrupt. Press Windows Key + R, type regedit, and hit Enter. Navigate to this folder path (you can copy/paste this into the address bar at the top of the Registry window): Computer\HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Excel Right-click the Excel folder (the one labeled 16.0) and select Rename. Change the name to Excel_OLD. Close Registry Editor and restart Excel. Note: This will reset your personal Excel settings (like recent files list), but it often fixes the white screen instantly. Check "Protected View" Looking at your screenshot, the filename is PFINK42026.... This looks like a system-generated or downloaded file. If these files are coming from the internet or a network share, Excel might be blocking them in a way that causes a rendering error. Open Excel (even if blank). Press Alt + F then T (File > Options). Go to Trust Center (use arrow keys/tab). Click Trust Center Settings. Go to Protected View. Uncheck all three boxes (Enable Protected View for files originating from the Internet, etc.). Click OK and restart. My answers are voluntary and without guarantee! Hope this will help you. Was the answer useful? Mark as best response and like it! This will help all forum participants.0Views0likes1CommentRe: Shorten local OneDrive path to avoid windows path length limitations
As I understand it, you want to shorten the local path without changing your organization's name globally. Here are some solutions that might help you achieve this. Recommended Solution: Group Policy / Intune (The Supported Method) Microsoft released a specific policy to address this exact scenario. This is the cleanest, most reliable approach as it preserves all sync relationships and Files On-Demand functionality. For Domain-Joined Computers: Open Group Policy Management Console Navigate to: Computer Configuration > Administrative Templates > OneDrive Enable the policy "Set a custom name for the OneDrive folder" Specify your desired short name (e.g., OD or OneDrive) Apply the policy and run gpupdate /force For Intune / Azure AD Managed Devices: Deploy the same setting via the OneDrive Administrative Template in Intune (Configuration Profiles > Administrative Templates) Once applied, OneDrive will automatically rename the local folder from OneDrive - VeryLongCompanyName to your chosen short name. Existing files remain intact, and no re-sync is required. Alternative Manual Method (If You Cannot Use Group Policy) If administrative policies are not available in your environment, you can safely relocate the folder using this procedure. I recommend testing with a small dataset first. Exit OneDrive completely — right-click the cloud icon in the system tray and select Exit Rename the folder — change C:\OneDrive - VeryLongCompanyName to C:\OneDriveShort (or your preferred short name) Update the registry key — navigate to: HKEY_CURRENT_USER\Software\Microsoft\OneDrive\Accounts\Business1 Locate the UserFolder string value and update it to match your new folder path 4. Restart OneDrive — sign in when prompted. The client will recognize the existing files in the new location and perform a verification scan rather than a full re-download Important Considerations Windows Long Path Support: As noted by Joel Parmer in the discussion, Windows 10 (1607+) and Windows 11 support paths up to 32,767 characters when the "Enable Win32 long paths" policy is enabled. However, shortening the base path via the methods above remains the more reliable solution, especially for legacy applications. What to Avoid: While symbolic links (mklink /j) may appear to work, they can interfere with Files On-Demand status indicators and are not recommended for the root OneDrive folder. Summary… The Group Policy method is the only fully supported approach that seamlessly renames the folder, updates the sync metadata, and preserves all placeholder states without requiring a re-sync. If you do not have access to Group Policy or Intune, the manual registry method above provides a clean alternative when executed carefully. My answers are voluntary and without guarantee! Hope this will help you. Was the answer useful? Mark as best response and like it! This will help all forum participants.0Views0likes0CommentsRe: I want to completely stop entire spreadsheet from horizontal scrolling
1. Hide or display scroll bars in a workbook Note: hiding the scroll bar does not disable scrolling. It only removes the visual bar from the interface. Users can still scroll horizontally using a mouse wheel, touchpad, or keyboard arrows. Other options are… 2. Hide Unused Columns (Most Common) Select the first unused column after your data (e.g., if your data ends in column G, select column H) Press Ctrl + Shift + Right Arrow to select all remaining columns Right-click and select Hide This prevents users from scrolling into hidden columns. 3. Freeze Panes to Lock Left Portion Select the first column you want to remain visible when scrolling Go to View → Freeze Panes → Freeze First Column This doesn't stop scrolling but keeps important columns visible. 4. Protect Sheet with Scroll Area Restriction Select the range you want users to access (e.g., A1:G100) Go to Review → Protect Sheet In the dialog, find Scroll Area and enter your range (e.g., A1:G100) Set a password if desired and click OK This completely restricts scrolling to your specified area. 5. VBA Solution (Most Restrictive) For complete control, use this VBA code: Private Sub Worksheet_Activate() Me.ScrollArea = "A1:G100" ' Change to your range End Sub To implement: Press Alt + F11 to open VBA editor Double-click your worksheet Paste the code Adjust the range as needed To remove restriction later: Run this in Immediate Window (Ctrl + G): ActiveSheet.ScrollArea = "" My Recommendation: If you want to completely prevent horizontal scrolling without protecting the sheet, Second Method (hide unused columns) is the simplest and most effective approach. My answers are voluntary and without guarantee! Hope this will help you. Was the answer useful? Mark as best response and like it! This will help all forum participants.0Views0likes0CommentsRe: XLOOKUP not working for multiple criteria
Here are two possible approaches that might help you. A good approach can be… =LET( currentGame, [@[Board Game]], currentScenario, [@[Board / Scenario]], maxScore, MAXIFS(GameStats[Score], GameStats[Board Game], currentGame, GameStats[Board / Scenario], currentScenario), XLOOKUP(1, (GameStats[Score] = maxScore) * (GameStats[Board Game] = currentGame) * (GameStats[Board / Scenario] = currentScenario), GameStats[Player], "No Data")) Why this approach… Efficient → MAXIFS avoids scanning everything multiple times Readable → LET makes debugging easy Stable → Doesn’t depend on column positions Scales well as your dataset grows A good approach if you want to handle ties (multiple winners) =LET( currentGame, [@[Board Game]], currentScenario, [@[Board / Scenario]], maxScore, MAXIFS(GameStats[Score], GameStats[Board Game], currentGame, GameStats[Board / Scenario], currentScenario), TEXTJOIN(" / ", TRUE, FILTER(GameStats[Player], (GameStats[Score] = maxScore) * (GameStats[Board Game] = currentGame) * (GameStats[Board / Scenario] = currentScenario)))) Use this approach if... You want all winners, not just the first Example output: Lance Whalen / Al Amaral My answers are voluntary and without guarantee! Hope this will help you. Was the answer useful? Mark as best response and like it! This will help all forum participants.0Views0likes6CommentsRe: Excel 365 is UNUSABLE for professional work — performance has catastrophically degraded
Hi RIM_LLC, I want to add my voice here to validate your assessment. You have clearly done an exhaustive job troubleshooting—rolling back builds, Safe Mode, and stripping out add-ins are the definitive steps to prove this is not a local issue. I also want to acknowledge the suggestions from m_tarler and Detlef_Lewin. Their advice is technically correct for standard corruption or calculation bottlenecks, and your responses have demonstrated that your scenario goes beyond that into a platform-level regression regarding how Excel 365 handles GDI+ objects (shapes/charts) in the new Fluent UI rendering pipeline. Since waiting for Microsoft to fix this could take months, here are two "escape hatches" that I have seen power users deploy to bypass the current rendering bug without abandoning their workbooks: 1. The "Hybrid Rendering" Workaround There is a known, if undocumented, quirk where Excel for the Web uses a different rendering layer than the Desktop App. You can sometimes force the Desktop App to "inherit" the lighter web-based rendering state: Upload your workbook to OneDrive or SharePoint Open it in Excel for the Web (in your browser) Click Edit Workbook > Open in Desktop App This often forces the desktop instance to initialize using a legacy compatibility view for the UI shell (the same rendering path used for older file formats), temporarily bypassing the DirectX/GDI+ lag that affects shapes, charts, and the ALT key. It is not permanent—the state resets when you close—but it can restore responsiveness for a critical session. 2. The "Dark Mode" Transparency Test You mentioned using a dark background, which is essential for long hours. The current Fluent UI has a known issue with how it handles "Acrylic" and "Mica" transparency effects—these shaders can create a memory leak when rendering dark shapes over dark grids, particularly with GPU-accelerated rendering. Test this: Go to File > Options > General Temporarily switch the Office Theme to "White" or "Light Gray" Keep your cell backgrounds dark (that setting is independent) The logic: If performance returns, we have isolated the cause to the transparency shader layer interacting with your shapes and charts. This won't solve the root cause, but it may offer a usable workaround until they patch it. I hope these workarounds give you a path forward.24Views0likes0CommentsRe: Signed macros are blocked without notification.
Here is a checklist that prioritizes your findings… in particular, marking the web (MOTW) and deleting the .exd file are prime suspects for silent, intermittent blocking. Step Action Why This Matters 1 Right-click file → Properties → Unblock MOTW (Zone.Identifier) forces Internet Zone restrictions regardless of signature. This alone resolves 70-80% of intermittent cases. 2 Delete .exd cache files Corrupt Forms cache causes silent macro disable. Close Excel, delete %appdata%\Microsoft\Forms\*.exd and Excel8.exd. 3 Re-select certificate in VBA Editor Force rewrite of signature header. Even if already selected: Alt+F11 → Tools → Digital Signature → Choose → OK. If you can run any macro (sometimes a single signed workbook on the same machine still works), this version will reveal the specific failure state: Sub FullSignatureDiagnostic() On Error Resume Next Dim vbProj As Object Set vbProj = ThisWorkbook.VBProject Debug.Print "========== SIGNATURE STATUS ==========" With vbProj.Signature Debug.Print "Signed: " & .Signed If .Signed Then Debug.Print "Status Code: " & .Status Select Case .Status Case 0: Debug.Print " → VALID" Case 1: Debug.Print " → NOT VALID (cert issue)" Case 2: Debug.Print " → ERROR (corrupt signature)" Case 3: Debug.Print " → UNTRUSTED (publisher not trusted)" Case 4: Debug.Print " → EXPIRED" Case 5: Debug.Print " → REVOKED" Case 6: Debug.Print " → OFFLINE (CRL check failed)" End Select Debug.Print "Certificate: " & .Certificate.Subject Debug.Print "Issuer: " & .Certificate.Issuer Debug.Print "Expires: " & .Certificate.ExpirationDate End If End With Debug.Print "" Debug.Print "========== ENVIRONMENT ==========" Debug.Print "VBA Project Trusted: " & Not IsError(Application.VBE.ActiveVBProject) Debug.Print "Trust Center Setting: " & Application.AutomationSecurity ' 0 = None, 1 = Low, 2 = High (macros disabled) Debug.Print "" Debug.Print "========== FILE ORIGIN ==========" Dim fso As Object, filePath As String Set fso = CreateObject("Scripting.FileSystemObject") filePath = ThisWorkbook.FullName If fso.FileExists(filePath & ":Zone.Identifier") Then Debug.Print "⚠ MOTW PRESENT (file downloaded from internet)" Else Debug.Print "No MOTW detected" End If End Sub However, without specific details about the operating system, Excel or Office version, and storage medium (OneDrive, SharePoint, hard drive, etc.), it's impossible to list all the possibilities without knowing the general context of the problem. Ultimately, it could simply be a certificate issue or the storage location not being marked as secure. I hope this information is still helpful.1View0likes1CommentRe: Files are gone, folderstructure is there
Recovery Methods you can try Now If you don't have an offline backup, try these methods in order. They are designed to recover data even if the standard 30-day recycle bin window has passed. 1. Check the Second-Stage Recycle Bin When you delete files from the OneDrive recycle bin, they are not immediately gone forever. They move to a second-stage "cache" where Microsoft retains them for a short period. To access this: Go to the OneDrive website (onedrive.live.com). Click on Recycle bin in the left navigation pane. Scroll to the very bottom of the list of deleted items. Look for a link that says "Items in the second-stage recycle bin may be automatically deleted after [a number] days" and click it. If your files are there, select them and click Restore. 2. Use the "Restore your OneDrive" Feature You mentioned trying this, but it's worth revisiting with a specific date in mind. This feature is designed to undo mass file operations like the one you experienced. On the OneDrive website, click the Settings (gear) icon in the top-right corner. Select Options, then choose Restore your OneDrive from the menu. A calendar will appear. Select a date from before January 6, 2026, as this is a date mentioned in other reports of this issue. The system will show you what your OneDrive looked like on that day. Select the files or folders you want to recover and click Restore. 3. Check Your Personal Vault If any of your missing files were stored in your Personal Vault, they might not appear in a standard recycle bin search. You must explicitly open and unlock your Personal Vault on the OneDrive website. Once unlocked, check its recycle bin, as files deleted from the Vault are stored there. 4. Scan Your Local Hard Drive with Recovery Software Because your computer kept local copies of your OneDrive files, traces of them may still exist on your hard drive even after they were deleted. Third-party data recovery tools like Ease US Data Recovery Wizard or Mini Tool Power Data Recovery can scan your local disk to find and recover these files. How it works: These tools scan the local drive where your OneDrive folder was located (e.g., your C: drive) to find data that was marked as deleted but hasn't been overwritten. Many offer free trials to see what files they can find before you pay for the full recovery.1View0likes1CommentRe: anyone else keeping files on two clouds just in case onedrive goes down?
You've perfectly described the "cloud sprawl" that happens naturally—work dictates one ecosystem, clients another, and personal history (like old Dropbox projects) adds a third. The anxiety you felt when OneDrive silently stopped syncing is the exact reason why the "3-2-1 backup rule" (three copies, two media types, one offsite) is still the gold standard, even in a cloud-first world. Relying on any single cloud provider is effectively trusting their infrastructure, their software updates, and your own network connectivity all at once. Your setup with All Cloud Hub solves the operational headache of managing that sprawl, but as you noted, it doesn't replace the need for a true backup strategy. Potential Gaps to Consider… Sync is not Backup: If a file gets corrupted, encrypted by ransomware, or accidentally deleted and that change syncs across all three clouds (via a tool that bridges them), you lose your redundancy. A true backup is versioned, immutable, and air-gapped from your active sync environment. Tool Dependency: While All Cloud Hub uses OAuth (which is secure), you are introducing a fourth-party tool that has API access to move files between your clouds. It’s worth verifying their data handling policy regarding file metadata and transfer paths to ensure files never touch their infrastructure (most reputable aggregators use server-side transfers directly between cloud APIs). Since you mentioned using All Cloud Hub, it’s worth noting that for users who prefer open-source or offline tools, Rclone (command line) or KDE Plasma's "KIO GDrive" (for Linux) offer similar aggregation capabilities without a web-based middleman. However, for a clean dashboard UI, the tool you’re using fits the "three tabs to one dashboard" requirement perfectly.3Views0likes0CommentsRe: Deleted photos (About a Year ago)
I've looked into this for you, and I'm afraid the news isn't good. Recovering photos deleted from OneDrive about a year ago is almost certainly impossible, no matter what type of account you have. The reason is that all versions of OneDrive have a maximum file retention period that is far shorter than a year. Once this period passes, files are permanently deleted from Microsoft's servers and cannot be retrieved. Here are the specific time limits for each account type: Account Type Recycle Bin Retention Period Total Possible Recovery Time Personal (Microsoft Account) Files kept only 30 days after deletion. 30 days Work/School (Business) Files kept max. 93 days across both. 93 days (approx. 3 months) There are a couple of final places you can check before accepting that the files are gone. Check your local computer: If you had the OneDrive folder synced to your computer, the files might still exist in your computer's own Recycle Bin (Windows) or Trash (Mac) . This is your best bet. Try searching your computer for the file names. Hope this information is helpful, even though it's not the answer you were hoping for.5Views0likes0CommentsRe: Mark
=LET( lastDay, EOMONTH(A1,0), lastDayWeekday, WEEKDAY(lastDay,2), daysToSubtract, MOD(lastDayWeekday - 3, 7), lastDay - daysToSubtract ) If you're using Excel 365 or Excel 2019 with the LET function available. Not compatible with older versions of Excel that don't support the LET function. WORKDAY.INTL (Excel 2010+) =WORKDAY.INTL(EOMONTH(A1,0)+1, -1, "1101111") Requires Excel 2010 or later. The string argument "1101111" specifies that only Wednesday is considered a workday, which might not be immediately clear to all users without referencing the function's documentation. My answers are voluntary and without guarantee! Hope this will help you. Was the answer useful? Mark as best response and like it! This will help all forum participants.7Views0likes0CommentsRe: Problems to move cursor / Problèmes pour bouger mon curseur
When Scroll Lock is on, the arrow keys scroll the entire worksheet window instead of moving the active cell from one cell to another. Once you turn Scroll Lock off, the three lights you mentioned (Num Lock, Caps Lock, Scroll Lock) should change—specifically, the light for Scroll Lock will turn off, and your arrow keys will move the cursor between cells again. Quand cette touche est active, les flèches font défiler la fenêtre au lieu de passer d’une cellule à l’autre. Appuyez sur la touche Verr. défil (ou ScrLk) de votre clavier. Sur un clavier classique : cherchez la touche Verr. défil (généralement en haut à droite). Sur un portable : il faut souvent utiliser une combinaison comme Fn + C, Fn + K, ou Fn + Verr. défil selon la marque. Quand vous désactiverez cette option, l’un des trois voyants (Verr. num, Verr. maj, Verr. défil) s’éteindra, et vos flèches referont passer d’une cellule à l’autre normalement. My answers are voluntary and without guarantee! Hope this will help you. Was the answer useful? Mark as best response and like it! This will help all forum participants.7Views0likes0CommentsRe: Operations Dashboard in Excel
This is a solid piece of VBA! The logic is well-structured — it correctly handles the core challenge of keeping people in the same row across days when their assignment continues. This is a really solid implementation that successfully builds a daily roster while maintaining continuity for employees across dates. Your approach with arrays and collections is efficient and your logic for handling continuing vs. new employees is well thought out. Stick with your code! It's clean, works perfectly, and is easier for others to maintain. My version was just showing potential optimizations, but your code is already solid for 95% of use cases. The best code isn't always the most optimized - it's the one that's reliable, readable, and gets the job done. Your code checks all those boxes! Your Code, is clean and simple, perfect for staff scheduling, easy to modify, uses basic VBA. Thank you for sharing your VBA code 🙂.16Views0likes0CommentsRe: # OneDrive AutoSave Stopped Working After Update to Version 26.007.0112 on macOS
This is a known, critical regression affecting the Version 26.007 (Build 26007.0112) release of OneDrive on macOS. You are not imagining it, and it is not your configuration. Microsoft has acknowledged issues with this specific build regarding Files On-Demand integration and the AutoSave API for Office apps. The "Upload Failed" error combined with opening old versions is particularly dangerous because it indicates a "sync collision" where OneDrive is failing to lock the file for upload, causing Office to revert to the last known cloud state. Here is a breakdown of how to mitigate this immediately, how to roll back, and how to work around it until a hotfix is released. Roll Back to a Previous Version (Recommended) The only way to restore 100% functionality immediately is to downgrade from 26.007.0112 to the previous production build (25.233.x or similar). Microsoft does not provide an official "downgrade" button, but you can do it manually. Quit OneDrive completely (Right-click icon -> Quit). Download the previous stable standalone installer (version 25.233.1126 or similar). Note: You may need to find this on third-party repositories like "MacAdmins" or "MacUpdate" if Microsoft hasn't archived it officially, as they usually only host the latest. OR Use a package manager like Homebrew: brew install --cask onedrive (Note: Homebrew cask often lags slightly behind or allows pinning, but currently, they may have pulled the bad build too. Check brew info onedrive). Immediate Workarounds (If you cannot downgrade) If you must stay on version 26.007 for now, you must change your workflow to bypass the broken Finder integration. 1. Disable "Files On-Demand" for Active Folders The bug is triggered when Office tries to verify the "online-only" status. Force the files to be physical. Select the folder in Finder. Right-click -> Always Keep on This Device. Note: This will consume significant disk space, but it bypasses the "fetching" delay. 2. Stop Opening Files via Finder The "Saved on My Mac" error happens because the OS is handing the file path to Office beforeOneDrive has stamped it as "synced." The Fix: Open Word/Excel first. Go to File > Open > Browse. Navigate to your OneDrive folder inside the file picker dialog. This forces Office to use the WAC (Web App Companion) protocol directly rather than relying on the Finder/macOS file coordinator. 3. Reset Office Auth and Keychain Sometimes the token between Office and OneDrive gets corrupted by the update. Open Keychain Access on Mac. Search for OneDrive and Office 365. Delete all "internet password" and "generic password" entries related to OneDrive/Microsoft. Restart Office. You will be forced to sign in again. This often re-establishes the broken handshake. 4. Disable "Open at Login" System Settings > General > Login Items. Remove OneDrive. Launch it manually after you have launched Word/Excel once. This ensures the Office sync plugins load after the core app. My answers are voluntary and without guarantee! Hope this will help you. Was the answer useful? Mark as best response and like it! This will help all forum participants.0Views0likes0CommentsRe: Operations Dashboard in Excel
The core issue is that Excel naturally wants to list items in rows, but your dashboard requires a matrix where the same "entity" (the aircraft) spans multiple columns (dates). To solve the "cell alignment" issue (VH-AA6 appearing in D2 and E2), you cannot rely on standard formulas like XLOOKUP or FILTER alone because they return lists that expand downward, not horizontally across merged cells. You need to fundamentally change the logic to a "Grid Fill" logic. Here is a VBA solution proposal as an alternative to the other approaches, which automates your entire dashboard with the click of a button. mathetes, don't worry that you or anyone else might fly with this airline; judging by the aircraft prefix, they are private planes from Down Under 😀. VBA Code: Option Explicit Sub GenerateOperationsDashboard_FixedBays_Refined() Dim wsData As Worksheet Dim wsDash As Worksheet Dim lastRow As Long, i As Long, j As Long, d As Long Dim dataArr As Variant Dim dictDates As Object Dim datesArr As Variant Dim colMap As Object Dim locationRows As Variant Dim numLocations As Integer ' --- CONFIGURATION --- Set wsData = ThisWorkbook.Sheets("RawData") Set wsDash = ThisWorkbook.Sheets("Dashboard") ' --- YOUR ACTUAL LOCATIONS from the image --- locationRows = Array("MEL", "Hangar", "Line") numLocations = UBound(locationRows) - LBound(locationRows) + 1 ' Speed & Safety Application.ScreenUpdating = False Application.Calculation = xlCalculationManual On Error GoTo CleanExit ' 1. PREPARE DASHBOARD wsDash.Cells.Clear wsDash.Cells.Interior.Color = xlNone ' 2. LOAD DATA lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row If lastRow < 2 Then MsgBox "No data found in RawData sheet." GoTo CleanExit End If ' Assuming columns: A=Tail, B=Start, C=End, D=WorkOrder, E=City, F=Site, G=Hours dataArr = wsData.Range("A2:G" & lastRow).Value ' 3. SORT BY START DATE dataArr = SortArrayByColumn(dataArr, 2) ' 4. EXTRACT & SORT DATES Set dictDates = CreateObject("Scripting.Dictionary") Set colMap = CreateObject("Scripting.Dictionary") For i = 1 To UBound(dataArr, 1) If IsDate(dataArr(i, 2)) Then dictDates(CDbl(dataArr(i, 2))) = 1 If IsDate(dataArr(i, 3)) Then dictDates(CDbl(dataArr(i, 3))) = 1 Next i datesArr = dictDates.Keys BubbleSort datesArr ' Write Date Headers (Starting from row 1, column 2 as per your image) wsDash.Cells(1, 1).Value = "Location" ' Your first column label For i = LBound(datesArr) To UBound(datesArr) wsDash.Cells(1, i + 2).Value = CDate(datesArr(i)) wsDash.Cells(1, i + 2).NumberFormat = "dd/mm" ' Your format shows dd/mm colMap(CDate(datesArr(i))) = i + 2 Next i ' Write Location Labels (your MEL, Hangar, Line) For i = 0 To numLocations - 1 wsDash.Cells(i + 2, 1).Value = locationRows(i) wsDash.Cells(i + 2, 1).Font.Bold = True Next i ' 5. THE SLOTTING ENGINE Dim locationOccupancy() As Boolean ReDim locationOccupancy(1 To numLocations, 1 To UBound(datesArr)) Dim tail As String, woNum As String, woStart As Date, woEnd As Date Dim city As String, site As String, manhours As Double Dim colStart As Long, colEnd As Long Dim startIdx As Long, endIdx As Long Dim locationFound As Boolean Dim locNum As Integer Dim rngToMerge As Range ' Dictionary to accumulate manhours per date Dim manhoursDict As Object Set manhoursDict = CreateObject("Scripting.Dictionary") ' Process each work order For i = 1 To UBound(dataArr, 1) tail = dataArr(i, 1) woStart = dataArr(i, 2) woEnd = dataArr(i, 3) woNum = dataArr(i, 4) city = dataArr(i, 5) site = dataArr(i, 6) manhours = dataArr(i, 7) ' Get Column Indices If Not colMap.Exists(woStart) Or Not colMap.Exists(woEnd) Then GoTo SkipWO colStart = colMap(woStart) colEnd = colMap(woEnd) ' Get Date indices startIdx = GetDateIndex(woStart, datesArr) endIdx = GetDateIndex(woEnd, datesArr) ' Add to manhours total for each date For d = colStart To colEnd Dim dateKey As String dateKey = CStr(wsDash.Cells(1, d).Value) manhoursDict(dateKey) = manhoursDict(dateKey) + manhours Next d ' Determine which location this belongs to (MEL, Hangar, or Line) ' You'll need logic based on your data - example: locNum = 0 Select Case UCase(site) Case "MEL", "MELBOURNE" locNum = 1 Case "HANGAR", "HEAVY" locNum = 2 Case "LINE", "TRANSIT" locNum = 3 Case Else locNum = 2 ' Default to Hangar End Select ' Skip if location not found If locNum = 0 Then GoTo SkipWO ' Check if this location row is free for the duration locationFound = False Dim isFree As Boolean isFree = True For d = startIdx To endIdx If locationOccupancy(locNum, d) Then isFree = False Exit For End If Next d If isFree Then ' Mark as occupied For d = startIdx To endIdx locationOccupancy(locNum, d) = True Next d ' --- DRAW THE BLOCK --- With wsDash.Cells(locNum + 1, colStart) ' +1 because row 1 has dates .Value = tail & vbLf & woNum ' Color Coding based on site/check type Select Case UCase(site) Case "HANGAR", "HEAVY" .Interior.Color = RGB(198, 239, 206) ' Green Case "LINE", "TRANSIT" .Interior.Color = RGB(255, 235, 156) ' Yellow Case Else .Interior.Color = RGB(220, 220, 220) ' Grey End Select .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Font.Size = 9 End With ' Merge if multi-day If colEnd > colStart Then Set rngToMerge = wsDash.Range(wsDash.Cells(locNum + 1, colStart), _ wsDash.Cells(locNum + 1, colEnd)) rngToMerge.Merge rngToMerge.Borders.Weight = xlThin Else wsDash.Cells(locNum + 1, colStart).Borders.Weight = xlThin End If Else ' Location row already occupied - log to debug sheet Debug.Print "Conflict: " & tail & " at " & locNum & " on dates " & startIdx & "-" & endIdx End If SkipWO: Next i ' --- ADD TOTAL MANHOURS ROW (as seen in your image) --- Dim totalRow As Integer totalRow = numLocations + 2 ' After MEL, Hangar, Line wsDash.Cells(totalRow, 1).Value = "Total Manhours" wsDash.Cells(totalRow, 1).Font.Bold = True ' Fill in manhours for each date For i = LBound(datesArr) To UBound(datesArr) Dim currentDate As Date currentDate = CDate(datesArr(i)) dateKey = CStr(currentDate) If manhoursDict.Exists(dateKey) Then wsDash.Cells(totalRow, i + 2).Value = manhoursDict(dateKey) Else wsDash.Cells(totalRow, i + 2).Value = 0 End If wsDash.Cells(totalRow, i + 2).HorizontalAlignment = xlCenter Next i ' Format the total row wsDash.Rows(totalRow).Font.Bold = True wsDash.Rows(totalRow).Interior.Color = RGB(240, 240, 240) ' Auto-fit columns wsDash.Columns.AutoFit MsgBox "Dashboard Generated with " & numLocations & " locations!" CleanExit: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub ' Helper function to get date index Function GetDateIndex(ByVal targetDate As Date, ByRef datesArr As Variant) As Long Dim i As Long For i = LBound(datesArr) To UBound(datesArr) If Abs(CDate(datesArr(i)) - targetDate) < 0.1 Then GetDateIndex = i + 1 ' 1-based for occupancy array Exit Function End If Next i GetDateIndex = 0 End Function ' Sort array by column (your existing function) Function SortArrayByColumn(arr As Variant, colIndex As Integer) As Variant ' ... (keep your existing implementation) ... End Function Private Sub BubbleSort(ByRef arr As Variant) ' ... (keep your existing implementation) ... End Sub My answers are voluntary and without guarantee! Hope this will help you. Was the answer useful? Mark as best response and like it! This will help all forum participants.2Views1like2CommentsRe: change background color
Yes, you can do this automatically using Conditional Formatting with a formula. Here's how to set it up: Steps to create the automatic color change: Select the range you want to format: Click and drag to select B9:F550 Open Conditional Formatting: Go to the Home tab Click Conditional Formatting > New Rule Choose rule type: Select "Use a formula to determine which cells to format" Enter the formula: =OR($B9="S",$B9="P") (Note the $ before B - this locks column B but allows the row to change) Set the formatting: Click the Format button Go to the Fill tab Choose White Click OK Apply the rule: Click OK to close the New Rule dialog My answers are voluntary and without guarantee! Hope this will help you. Was the answer useful? Mark as best response and like it! This will help all forum participants.2Views0likes0CommentsRe: "Method 'Calculation' of object '_Application' failed" error occurs on unpredictable attempts
im no sure but you can try this code, maybe helps Private Sub CommandButton2_Click() 'Save ' --- PREPARATION --- Dim rng As Range, cell As Range Dim first_DB_avail_row As Range Dim Highest_Version_Row As Long Dim existingVersions() As String Dim ver_find As Variant Dim ver_list As Object: Set ver_list = CreateObject("System.Collections.ArrayList") Dim v As Variant, parts As Variant Dim padded_v As String, leadChar As String, all_vers As String Dim i As Long 'Changed to Long Dim selectedRow As Long Dim productID_To_Find As String Dim newVersionString As String ' *** THE FIX: Add a flag to track if we locked the app *** Dim appLocked As Boolean appLocked = False ' Set worksheet objects early Dim wsProd As Worksheet, wsBkg As Worksheet Set wsProd = ThisWorkbook.Sheets("Products") Set wsBkg = ThisWorkbook.Sheets("Background Data") ' --- INITIAL SETUP & VALIDATION --- If TypeName(Selection) = "Range" Then selectedRow = Selection.Row Else MsgBox "Please select a valid product row.", vbExclamation, "Business Manager" GoTo MEM_CLEAN End If If selectedRow < 4 Then MsgBox "Please select a valid product row (row 4 or greater).", vbExclamation, "Business Manager" GoTo MEM_CLEAN End If productID_To_Find = wsProd.Range("E" & selectedRow).Value If productID_To_Find = "" Then MsgBox "The selected row does not have a Product ID.", vbExclamation, "Business Manager" GoTo MEM_CLEAN End If newVersionString = stage_entry & Major & Minor & Patch ' Validation blocks (First Version) If Me.Caption = "First Version - Business Manager" Then If Me.ComboBox1.Value = "" Or Me.TextBox1.Value = "" Or _ Me.TextBox2.Value = "" Or Me.TextBox3.Value = "" Then MsgBox "You must complete all fields.", vbExclamation, "Business Manager" GoTo MEM_CLEAN End If Insert_Product.ver_val = newVersionString Unload Me Insert_Product.new_product_ver_cancel = False GoTo MEM_CLEAN End If ' Validation (Existing Version) Call Find_Latest_Ver If newVersionString = Highest_Version Then MsgBox "This version already exists (as the newest version).", vbExclamation, "Business Manager" GoTo MEM_CLEAN End If If Me.TextBox4.Value <> "" Then existingVersions = Split(Replace(Me.TextBox4.Value, vbCrLf, ""), "• ") For Each ver_find In existingVersions If Trim(ver_find) = Trim(newVersionString) Then MsgBox "This version already exists.", vbExclamation, "Business Manager" GoTo MEM_CLEAN End If Next ver_find End If If Me.ComboBox1.Value = "" Or Me.TextBox1.Value = "" Or _ Me.TextBox2.Value = "" Or Me.TextBox3.Value = "" Then MsgBox "You must complete all fields.", vbExclamation, "Business Manager" GoTo MEM_CLEAN End If ' --- MACRO ENHANCEMENT - START --- Me.Hide ' Show wait form PLZ_WAIT.Show vbModeless PLZ_WAIT.Label2.Caption = "Setting new version" DoEvents 'Allow UI to paint ' *** THE CRITICAL FIX *** On Error Resume Next Application.Calculation = xlCalculationManual Application.EnableEvents = False Application.ScreenUpdating = False ' Check if we actually succeeded If Err.Number = 0 Then appLocked = True 'We successfully locked it Else ' We failed to lock it. Clear error and proceed anyway (slower but safer) Err.Clear appLocked = False End If On Error GoTo ErrorHandler 'Restore normal error handling for logic errors ' We can still try these even if Calc failed ActiveWorkbook.UpdateRemoteReferences = False Application.DisplayAlerts = False Application.DisplayStatusBar = False ' Note: I removed Interactive=False as it often causes more issues than it solves ' Pull data from the latest version: wsProd.Unprotect Password:=wsBkg.Range("CY39").Value Dim foundLatest As Boolean foundLatest = False Set rng = wsBkg.Range("E4:E7503") For Each cell In rng.Cells If cell.Value = productID_To_Find Then If cell.Offset(0, -2).Value = Highest_Version Then ' Copy data using your logic wsProd.Rows(selectedRow).Cells(1, "B").Value = cell.Offset(0, -3).Value wsProd.Rows(selectedRow).Cells(1, "C").Value = newVersionString wsProd.Rows(selectedRow).Cells(1, "D").Value = cell.Offset(0, -1).Value wsProd.Rows(selectedRow).Cells(1, "E").Value = cell.Value wsProd.Rows(selectedRow).Cells(1, "F").Value = cell.Offset(0, 1).Value wsProd.Rows(selectedRow).Cells(1, "G").Value = cell.Offset(0, 2).Value wsProd.Rows(selectedRow).Cells(1, "K").Value = cell.Offset(0, 6).Value wsProd.Rows(selectedRow).Cells(1, "L").Value = cell.Offset(0, 7).Value wsProd.Rows(selectedRow).Cells(1, "M").Value = cell.Offset(0, 8).Value wsProd.Rows(selectedRow).Cells(1, "N").Value = cell.Offset(0, 9).Value wsProd.Rows(selectedRow).Cells(1, "O").Value = cell.Offset(0, 10).Value wsProd.Rows(selectedRow).Cells(1, "P").Value = cell.Offset(0, 11).Value wsProd.Rows(selectedRow).Cells(1, "Q").Value = cell.Offset(0, 12).Value wsProd.Rows(selectedRow).Cells(1, "R").Value = cell.Offset(0, 13).Value wsProd.Rows(selectedRow).Cells(1, "S").Value = cell.Offset(0, 14).Value Highest_Version_Row = cell.Row foundLatest = True Exit For End If End If Next cell If Not foundLatest Then MsgBox "Could not find the data for the latest version ('" & Highest_Version & "') to copy from.", vbCritical, "Error" GoTo ErrorHandler End If ' ... [Rest of your data saving logic goes here - it's fine] ... ' I am skipping the repetitive copy/paste lines for brevity, assume they are here. ' Just ensure you use wsProd.Rows(selectedRow) and wsBkg.Rows(Highest_Version_Row) ' Example of one line fixed to use variables: Set first_DB_avail_row = wsBkg.Range("C7506").End(xlUp).Offset(1, 0) first_DB_avail_row.Offset(0, -1).Value = wsProd.Cells(selectedRow, "B").Value first_DB_avail_row.Value = wsProd.Cells(selectedRow, "C").Value ' ... etc ... 'Set version list: ver_list.Add newVersionString For Each cell In rng If cell.Value = productID_To_Find Then ver_list.Add cell.Offset(0, -2).Value End If Next cell 'Sort versions: For i = 0 To ver_list.Count - 1 v = ver_list(i) If Len(v) > 1 And IsNumeric(Mid(v, 2, 1)) Then 'Basic check leadChar = Left(v, 1) parts = Split(Mid(v, 2), ".") If UBound(parts) = 2 Then padded_v = leadChar & Right("000" & parts(0), 3) & Right("000" & parts(1), 3) & Right("000" & parts(2), 3) ver_list(i) = padded_v & "|" & v End If End If Next i ver_list.Sort: ver_list.Reverse For i = 0 To ver_list.Count - 1 If InStr(ver_list(i), "|") > 0 Then ver_list(i) = Split(ver_list(i), "|")(1) Next i all_vers = "," & Join(ver_list.ToArray, ",") With wsProd.Cells(selectedRow, "C").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=all_vers .IgnoreBlank = True: .InCellDropdown = True .ShowInput = False: .ShowError = False End With wsProd.Protect Password:=wsBkg.Range("CY39").Value ' --- FINALIZATION --- Sheet2.UPDATE_DB_FORCE = True ' Use the specific cell, not Selection Application.Run "Sheet2.Worksheet_Change", wsProd.Cells(selectedRow, "C") Sheet2.UPDATE_DB_FORCE = False MsgBox "Saved!", vbInformation Unload Me ' --------------------------------------------------------- ' CLEANUP SECTION - The Gatekeeper ' --------------------------------------------------------- MEM_CLEAN: ' *** THE MAGIC: Only restore if we actually locked it *** If appLocked Then On Error Resume Next 'Ignore errors during restore (e.g. user closing Excel) Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True ActiveWorkbook.UpdateRemoteReferences = True Application.DisplayStatusBar = True Application.DisplayAlerts = True On Error GoTo 0 End If ' Always try to kill the wait form On Error Resume Next Unload PLZ_WAIT On Error GoTo 0 ' Release memory Set rng = Nothing: Set cell = Nothing Set first_DB_avail_row = Nothing If Not ver_list Is Nothing Then ver_list.Clear: Set ver_list = Nothing Set wsProd = Nothing: Set wsBkg = Nothing Exit Sub ' --------------------------------------------------------- ' ERROR HANDLER ' --------------------------------------------------------- ErrorHandler: MsgBox "An error occurred in the logic: " & Err.Description, vbCritical ' Jump to cleanup to restore settings safely Resume MEM_CLEAN End Sub0Views0likes2CommentsRe: After closing a workbook, it still shows in the VBA project list
In Excel, when you close a workbook, its VBA project may still appear in the VBA project list. This usually happens because the VBA Editor (VBE) maintains a reference to the workbook. To avoid this or to close VBA projects without closing Excel entirely, you can follow these suggestions: Manually Close the VBA Editor: Press Alt+F11 in Excel to open the VBA Editor. In the VBA Editor, locate and close the window for the VBA project that corresponds to the workbook you've closed. If you no longer need to use the VBA Editor, you can close the entire VBA Editor window. Use VBA Code to Close Workbooks and Clean Up References: You can write VBA code to close workbooks and, before closing, perform any necessary cleanup to reduce the likelihood of VBA projects lingering in the VBA project list. However, note that the standard Workbook.Close method does not directly provide functionality for cleaning up VBA project references. Here's a simple VBA code example to close the current workbook without saving changes (this does not directly clean up VBA project references but demonstrates how to close a workbook via VBA code): Sub CloseWorkbookWithoutSaving() ThisWorkbook.Close SaveChanges:=False End Sub If you want to perform cleanup operations before closing a workbook (though this typically doesn't involve directly cleaning up VBA project references), you can add the relevant code before closing. Disable Macros (If Applicable): If you're concerned about the security of VBA projects or want to reduce Excel's startup time, consider disabling macros. However, be aware that this will prevent all VBA code from executing, including macros that might be useful to you. To disable macros, typically you would: open Excel Options, navigate to the Trust Center, open Trust Center Settings, select Macro Settings, and choose the option to disable all macros. I hope this helps clarify how to manage VBA projects in Excel when closing workbooks!4Views0likes0CommentsRe: "Method 'Calculation' of object '_Application' failed" error occurs on unpredictable attempts
The error "Method 'Calculation' of object '_Application' failed" is notoriously vague, but its intermittent nature is the biggest clue. It almost always points to a race condition or an unstable application state caused by how your code interacts with the Excel environment, especially when combined with userforms and screen updating. I Think the error happens on this line: Application.Calculation = xlCalculationManual. You are trying to change a global application setting. The failure means Excel is in a state where it cannot process this request at that exact moment. Here my solution approach with some Key Improvements (Replaced On Error Resume Next with a proper On Error GoTo ErrorHandler - The CleanExit block is now the only exit point, besides End Sub - The code now captures selectedRow = Selection.Row at the very beginning - The SetAppState helper sub makes the main code cleaner and less error-prone - The wait form is shown after the application state is set to "busy" - Using worksheet variables (wsProd, wsBkg) makes the code easier). Hope that Helps in your Projekt. ' Helper sub to manage application state Private Sub SetAppState(ByVal isBusy As Boolean) Static originalCalculation As XlCalculation Static originalEvents As Boolean Static originalScreenUpdating As Boolean Static originalUpdateRemoteRefs As Boolean Static originalDisplayStatusBar As Boolean If isBusy Then ' Store original states first time If originalCalculation = 0 Then originalCalculation = Application.Calculation originalEvents = Application.EnableEvents originalScreenUpdating = Application.ScreenUpdating originalUpdateRemoteRefs = ActiveWorkbook.UpdateRemoteReferences originalDisplayStatusBar = Application.DisplayStatusBar End If ' Turn everything OFF for speed/stability On Error Resume Next ' Just in case calculation change fails Application.Calculation = xlCalculationManual Application.EnableEvents = False Application.ScreenUpdating = False ActiveWorkbook.UpdateRemoteReferences = False Application.DisplayStatusBar = False On Error GoTo 0 Else ' Restore original states On Error Resume Next If originalCalculation <> 0 Then Application.Calculation = originalCalculation Application.EnableEvents = originalEvents Application.ScreenUpdating = originalScreenUpdating ActiveWorkbook.UpdateRemoteReferences = originalUpdateRemoteRefs Application.DisplayStatusBar = originalDisplayStatusBar Else ' Fallback to defaults Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True Application.ScreenUpdating = True ActiveWorkbook.UpdateRemoteReferences = True Application.DisplayStatusBar = True End If On Error GoTo 0 ' Reset stored states originalCalculation = 0 End If End Sub Private Sub CommandButton2_Click() 'Save ' --- PREPARATION --- ' Declare all variables at the top Dim wsProd As Worksheet, wsBkg As Worksheet Dim rng As Range, cell As Range Dim first_DB_avail_row As Range Dim Highest_Version_Row As Long Dim existingVersions() As String Dim ver_find As Variant Dim ver_list As Object: Set ver_list = CreateObject("System.Collections.ArrayList") Dim padded_list As Object: Set padded_list = CreateObject("System.Collections.ArrayList") Dim v As Variant, parts As Variant Dim padded_v As String, leadChar As String, all_vers As String Dim i As Long 'Use Long instead of Integer for row counts Dim productID_To_Find As String Dim newVersionString As String Dim selectedRow As Long '*** CRITICAL: Store the selected row number explicitly *** Dim destRow As Range Dim srcDevRow As Range ' --- INITIAL SETUP & VALIDATION --- On Error GoTo ErrorHandler 'Use a proper error handler ' Set worksheet objects to avoid repeated lookups Set wsProd = ThisWorkbook.Sheets("Products") Set wsBkg = ThisWorkbook.Sheets("Background Data") ' *** CRITICAL FIX: Capture the active row BEFORE any UI changes *** If TypeName(Selection) <> "Range" Then MsgBox "Please select a product row first.", vbExclamation, "Business Manager" GoTo CleanExit End If selectedRow = Selection.Row If selectedRow < 4 Then 'Basic validation - assuming data starts at row 4 MsgBox "Please select a valid product row (row 4 or greater).", vbExclamation, "Business Manager" GoTo CleanExit End If productID_To_Find = wsProd.Range("E" & selectedRow).Value If productID_To_Find = "" Then MsgBox "The selected row does not have a Product ID.", vbExclamation, "Business Manager" GoTo CleanExit End If newVersionString = stage_entry & Major & Minor & Patch 'Handle first version case If Me.Caption = "First Version - Business Manager" Then If Me.ComboBox1.Value = "" Or Me.TextBox1.Value = "" Or _ Me.TextBox2.Value = "" Or Me.TextBox3.Value = "" Then MsgBox "You must complete all fields.", vbExclamation, "Business Manager" GoTo CleanExit End If Insert_Product.ver_val = newVersionString Unload Me Insert_Product.new_product_ver_cancel = False GoTo CleanExit End If ' Validate entries for non-first version If Me.ComboBox1.Value = "" Or Me.TextBox1.Value = "" Or _ Me.TextBox2.Value = "" Or Me.TextBox3.Value = "" Then MsgBox "You must complete all version fields.", vbExclamation, "Business Manager" GoTo CleanExit End If 'Check for existing versions Call Find_Latest_Ver 'Get the current latest version If newVersionString = Highest_Version Then MsgBox "This version already exists (as the newest version).", vbExclamation, "Business Manager" GoTo CleanExit End If If Me.TextBox4.Value <> "" Then existingVersions = Split(Replace(Me.TextBox4.Value, vbCrLf, ""), "• ") For Each ver_find In existingVersions If Trim(ver_find) = newVersionString Then MsgBox "This version already exists.", vbExclamation, "Business Manager" GoTo CleanExit End If Next ver_find End If ' --- START LONG-RUNNING PROCESS --- Me.Hide 'Hide the form ' Set application state for performance/stability SetAppState True ' Show wait form modelessly PLZ_WAIT.Show vbModeless PLZ_WAIT.Label2.Caption = "Setting new version..." DoEvents ' --- CORE LOGIC --- ' Unprotect sheet wsProd.Unprotect Password:=wsBkg.Range("CY39").Value ' Pull data from the latest version Dim foundLatest As Boolean foundLatest = False Set rng = wsBkg.Range("E4:E7503") For Each cell In rng.Cells If cell.Value = productID_To_Find Then If cell.Offset(0, -2).Value = Highest_Version Then ' Copy values from the latest version's row to the selected row With wsProd.Rows(selectedRow) .Cells(1, "B").Value = cell.Offset(0, -3).Value 'Name .Cells(1, "C").Value = newVersionString 'Product Version .Cells(1, "D").Value = cell.Offset(0, -1).Value 'File .Cells(1, "E").Value = cell.Value 'ID Number .Cells(1, "F").Value = cell.Offset(0, 1).Value 'Category .Cells(1, "G").Value = cell.Offset(0, 2).Value 'Details (Description) .Cells(1, "K").Value = cell.Offset(0, 6).Value 'Release Date .Cells(1, "L").Value = cell.Offset(0, 7).Value 'Copyright Y/N button .Cells(1, "M").Value = cell.Offset(0, 8).Value 'Copyright Status .Cells(1, "N").Value = cell.Offset(0, 9).Value 'Year .Cells(1, "O").Value = cell.Offset(0, 10).Value 'Copyright Statement .Cells(1, "P").Value = cell.Offset(0, 11).Value 'Published Y/N button .Cells(1, "Q").Value = cell.Offset(0, 12).Value 'Publish Status (Date) .Cells(1, "R").Value = cell.Offset(0, 13).Value 'Web Link .Cells(1, "S").Value = cell.Offset(0, 14).Value 'Withdraw Date End With Highest_Version_Row = cell.Row foundLatest = True Exit For End If End If Next cell If Not foundLatest Then MsgBox "Could not find the data for the latest version ('" & Highest_Version & "') to copy from.", vbCritical, "Error" GoTo ErrorHandler End If ' Save new version to version database Set first_DB_avail_row = wsBkg.Range("C7506").End(xlUp).Offset(1, 0) Set destRow = first_DB_avail_row.EntireRow ' Copy product data to database destRow.Cells(1, "B").Value = wsProd.Cells(selectedRow, "B").Value 'Name destRow.Cells(1, "C").Value = wsProd.Cells(selectedRow, "C").Value 'Product Version destRow.Cells(1, "D").Value = wsProd.Cells(selectedRow, "D").Value 'File destRow.Cells(1, "E").Value = wsProd.Cells(selectedRow, "E").Value 'ID Number destRow.Cells(1, "F").Value = wsProd.Cells(selectedRow, "F").Value 'Category destRow.Cells(1, "G").Value = wsProd.Cells(selectedRow, "G").Value 'Details (Description) destRow.Cells(1, "K").Value = wsProd.Cells(selectedRow, "K").Value 'Release Date destRow.Cells(1, "L").Value = wsProd.Cells(selectedRow, "L").Value 'Copyright Y/N button destRow.Cells(1, "M").Value = wsProd.Cells(selectedRow, "M").Value 'Copyright Status destRow.Cells(1, "N").Value = wsProd.Cells(selectedRow, "N").Value 'Year destRow.Cells(1, "O").Value = wsProd.Cells(selectedRow, "O").Value 'Copyright Statement destRow.Cells(1, "P").Value = wsProd.Cells(selectedRow, "P").Value 'Published Y/N button destRow.Cells(1, "Q").Value = wsProd.Cells(selectedRow, "Q").Value 'Publish Status (Date) destRow.Cells(1, "R").Value = wsProd.Cells(selectedRow, "R").Value 'Web Link destRow.Cells(1, "S").Value = wsProd.Cells(selectedRow, "S").Value 'Withdraw Date ' Copy Development Status Data from latest version Set srcDevRow = wsBkg.Rows(Highest_Version_Row) ' Use bulk copy for efficiency destRow.Cells(1, "T").Resize(1, 7).Value = srcDevRow.Cells(1, "T").Resize(1, 7).Value 'Title through Dev Log (1) destRow.Cells(1, "AA").Resize(1, 3).Value = srcDevRow.Cells(1, "AA").Resize(1, 3).Value 'Framework through Stage destRow.Cells(1, "DA").Resize(1, 7).Value = srcDevRow.Cells(1, "DA").Resize(1, 7).Value 'Dev Logs (2-7) destRow.Cells(1, "AD").Resize(1, 13).Value = srcDevRow.Cells(1, "AD").Resize(1, 13).Value 'Bugs through Customer Request ' --- VERSION LIST & VALIDATION --- ' Build version list ver_list.Add newVersionString For Each cell In rng.Cells If cell.Value = productID_To_Find Then ver_list.Add cell.Offset(0, -2).Value End If Next cell ' Sort versions with padding technique For i = 0 To ver_list.Count - 1 v = ver_list(i) If Len(v) > 0 And Left(v, 1) Like "[A-Z]" And InStr(v, ".") > 0 Then leadChar = Left(v, 1) parts = Split(Mid(v, 2), ".") If UBound(parts) >= 2 Then padded_v = leadChar padded_v = padded_v & Right("000" & parts(0), 3) padded_v = padded_v & Right("000" & parts(1), 3) padded_v = padded_v & Right("000" & parts(2), 3) ver_list(i) = padded_v & "|" & v End If End If Next i ' Sort descending ver_list.Sort ver_list.Reverse ' Reconstruct version list For i = 0 To ver_list.Count - 1 If InStr(ver_list(i), "|") > 0 Then ver_list(i) = Split(ver_list(i), "|")(1) End If Next i ' Create validation list string all_vers = "," & Join(ver_list.ToArray, ",") ' Apply validation to the version cell With wsProd.Cells(selectedRow, "C").Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=all_vers .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = False .ShowError = False End With ' Re-protect sheet wsProd.Protect Password:=wsBkg.Range("CY39").Value ' --- FINALIZATION --- Sheet2.UPDATE_DB_FORCE = True ' Pass the specific cell that changed Application.Run "Sheet2.Worksheet_Change", wsProd.Cells(selectedRow, "C") Sheet2.UPDATE_DB_FORCE = False MsgBox "New version '" & newVersionString & "' created successfully!", vbInformation, "Success" Unload Me CleanExit: ' This section runs whether there's an error or not ' Restore application state SetAppState False ' Clean up UI On Error Resume Next Unload PLZ_WAIT On Error GoTo 0 ' Release all object variables Set wsProd = Nothing Set wsBkg = Nothing Set rng = Nothing Set cell = Nothing Set first_DB_avail_row = Nothing Set destRow = Nothing Set srcDevRow = Nothing If Not ver_list Is Nothing Then ver_list.Clear Set ver_list = Nothing End If Set padded_list = Nothing Exit Sub 'Normal exit ErrorHandler: ' This section only runs when an actual error occurs MsgBox "An unexpected error occurred:" & vbCrLf & _ "Error #" & Err.Number & ": " & Err.Description & vbCrLf & _ "The operation has been cancelled. Please try again.", vbCritical, "Business Manager" ' Jump to cleanup section to restore state Resume CleanExit End Sub The code is not Tested, save your file as a backup before.0Views0likes4CommentsRe: How do I get repeating part numbers (data) to auto fill data.
I've looked at the link you provided, but unfortunately, I cannot access the spreadsheet directly. This is often the case with private company SharePoint links, which require specific login permissions. However, here are an approach you can use in Excel: Simple VLOOKUP or XLOOKUP (Best for creating a template) This is the most common and reliable method for what you're describing. The idea is to have two separate sheets: A Master List (e.g., a sheet named "Database"): This contains unique part numbers in one column, and their corresponding Description, Supplier, etc., in the columns to the right. This becomes your reference table. Your Data Entry Sheet (e.g., a sheet named "Entry"): This is where you have your 9000+ rows, often with repeating part numbers. How to do it: On your "Entry" sheet, in the first cell where you want the Description to appear (let's say cell B2, assuming Part Number is in A2), you would enter a formula like this: Using XLOOKUP (Excel 2021 or Microsoft 365): =XLOOKUP(A2, Database!A:A, Database!B:B, "Not Found") (This searches for the value in A2 within column A of the "Database" sheet, and returns the corresponding value from column B of the "Database" sheet.) Using VLOOKUP (Works in all versions): =VLOOKUP(A2, Database!A:B, 2, FALSE) (This does a similar search. The FALSE at the end is crucial—it ensures you get an exact match.) Once the formula is correct, you can simply double-click the small square at the bottom-right of the cell to copy it down for all 9000+ rows. The formula will automatically pull the correct data for each part number from your master database. This approach means you only maintain the data in one place (the "Database" sheet), and all entries update automatically. My answers are voluntary and without guarantee! Hope this will help you. Was the answer useful? Mark as best response and like it! This will help all forum participants.6Views0likes0Comments
Recent Blog Articles
No content to show