Extract Same Table from Multiple PDFs
I tried to modify the recorded macro to accept another PDF in table 002 with the next monthly summary table (table001 & table002 confusion). All of the files are in the same folder numbered incrementally, 1-12 (Jan-Dec). There are other similar folders for different accounts requiring the same procedure be performed and are set up in similar increments by account. Would like all of the monthly summaries from the PDF table 001 listed within one worksheet or workbook. How can this macro perform the function described? Sub ExtrctMonthlySum() ' ' ExtrctMonthlySum Macro ' ' ActiveWorkbook.Queries.Add Name:="Table002 (Page 1)", Formula:= _ "let" & Chr(13) & "" & Chr(10) & " Source = Pdf.Tables(File.Contents(""T:\Traverse\Church International & Triumphant\DCTC\Financial\Treasurer\2024\Acct 1893\2.pdf""), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & " Table001 = Source{[Id=""Table001""]}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Table002,{{""Column1"", type text}, {""Column2"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type""" ActiveWorkbook.Worksheets.Add With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _ "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table002 (Page 1)"";Extended Properties=""""" _ , Destination:=Range("$A$1")).QueryTable .CommandType = xlCmdSql .CommandText = Array("SELECT * FROM [Table002 (Page 1)]") .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .ListObject.DisplayName = "Table002__Page_1" .Refresh BackgroundQuery:=False End With Range("C5").Select End Sub
Freeze Panes Question
Hello Excel Experts, I have a problem that I'm facing that maybe you all might be able to solve. I'm trying to freeze my top and side navigation bar in place in Excel. Technically I got the top bar to work, it stays in place when I scroll vertically and technically side bar is also frozen in place but only when scrolling horizontally. Anything below the top navigation bar when scrolling vertically moves. Is there a way to freeze both the top and side columns in place so my navigation buttons are always available to use without using VBA? I have tried the split window option, it works but there's the duplicate view of what was split which if there was a way to hide/lock that duplicate image behind the stationary split view. I also tried combining split view window with the Freeze pane option but that didn't really work I do have a video of what I am talking about with the freeze pane issue option that I'm having which I have attached, along with the file as well Thank you, and I look forward to the help!!!!!
Enable DTPicker Calendar in Excel/VBA
Hello! How are you? I am unable to enable the DTPicker calendar in Excel/VBA. I have already contacted Microsoft, and they told me that this control is already native to the version, but this control is not appearing for me. I have even downloaded MSCOMCT2.OCX, but it still does not appear. Please, someone help me to enable this control in my Excel/VBA.
Excel for Mac - Run-time error '1004': Method 'Name' of object 'Addin' failed
Dears, Whenever I open any Excel File (existing or blank), I get the following error message: "Visual Basic for Applications Run-time error '1004': Method 'Name' of object 'Addin' failed" Note: I don't have any VBA code in the file - again, this message also appears when opening a blank/new/empty file. I thought it could be related to one of the Add-ins that I had installed, but even after removing all of them, the message still appears. Does anybody know what it means and how to fix it? I'm running Excel for MacVersion 16.91 (24111020) from Microsoft 365 in macOS SequoiaVersion 15.1.1. Thanks in advance, Andre
Excel Macros Causing Display Glitches On Workbook with Multiple Pages and Formulas
Hello, I'm hoping someone can help me out here. I have seen a post with similar issues that was resolved, however, I tried the solution (turning on and off screen updating for the macros). The macros I am running are quite simple. Basically just unhiding and hiding sheets so that the user of the workbook doesnt have to type in a password to lock and unlock the workbook each time he needs to add more pages or remove unused pages. There are a lot of formulas that pull data from other areas of the workbook (Xlookup, Count, IF/And, Stuff like that) and what seems to be happening is on most pages when data is entered the active sheet becomes see through in random cells showing the next page. When I scroll down and up the sheet goes back to normal. For me it isn't an issue, however, I will be submitting this reporting template to a client multiple times and it would be nice if the workbook was working as intended. Please note that the example photos below are only one example. This issue happens on basically every page of the workbook. Here is what a sheet looks like prior to accessing the page when has the data on it that will fill this page (The blue cells are formula cells that pull data from the next page: Here is the upload page where I will add data that will get uploaded to the page above (You can see the issue in this photo): Here is what the page should look like:
KB5002653 issue with the Kernel Function GetCommandLineW
Hello, Just to warn about this specific issue, since the installation of the KB5002653 , From an Excel 2016 VBA the function GetCommandLineW give a truncated/different result. Sample Code: Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineW" () As Long Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (MyDest As Any, MySource As Any, ByVal MySize As Long) Function ReadCmdLine() As String Dim pCmdLine As Long ' Pointer to the string Dim Buffer() As Byte Dim StrLen As Long ' Get the pointer to the command line string pCmdLine = GetCommandLine StrLen = lstrlenW(pCmdLine) * 2 If StrLen Then ReDim Buffer(0 To (StrLen - 1)) As Byte CopyMemory Buffer(0), ByVal pCmdLine, StrLen ReadCmdLine = Buffer End If End Function Before the KB I had : "C:\PROGRA~2\MICROS~2\Office16\EXCEL.EXE excelfile.xlsm /parameter" After the KB I have : ""C:\PROGRA~2\MICROS~2\Office16\EXCEL.EXE" excelfile.xlsm"Assistance Needed with VBA Code for Copying Data
Hi, I'm seeking help with a VBA code I've implemented to copy data from the "By Facility" tab to the "CS_export" tab. The code functions correctly when there are multiple line items in the "By Facility" tab; however, it fails to operate when there is only a single line of data present. I’ve attached an example of how the "By Facility" tab looks in my original file. I would appreciate any guidance or solutions you could provide. VBA code Public Sub Export_Supply_Chain() Dim wbMaster As Workbook Dim wbNewWorkbook As Workbook Dim wsTemplate As Worksheet Dim wsWIP As Worksheet Dim wsDetail As Worksheet Dim wsNewDetail As Worksheet Dim wsCS_Export As Worksheet On Error GoTo Error_handler Dim rngTerr As Range Dim rngDistLeads As Range Dim rngCell As Range Dim rngHeader As Range Dim rngCS_Export As Range Dim ChartObj As Object Dim strPath As String Dim strFileName As String Dim strTerr As String Dim strHospital As String 'Dim wsTest As String Dim strFile As String Dim strSheet As String Dim MyNewBook As String Dim lnSheetName As Long Dim count As Integer Dim Row_Count As Integer Dim DefaultFilePath As String Dim FileSelected As String Dim wbRepsWorkbook As Workbook Dim wsTerr As Worksheet Dim wsTest As Worksheet Dim wsAdd As Worksheet Dim wsLooseEstimate As Worksheet Dim rngHeaderNALT As Range Dim wsNewALT As Worksheet Dim rngHeaderAdd As Range Dim wsNewAdd As Worksheet Dim rngHeaderALT As Range Dim cell As Range Dim delRange As Range Dim wsNewComp As Worksheet Dim rngHeaderComp As Range Dim strTerr_train As String With Application .ScreenUpdating = False .DisplayAlerts = True End With Set wbMaster = ThisWorkbook strHospital = wbMaster.Worksheets("OS").Range("C4") With wbMaster 'Set wsInput = .Sheets("LooseEstimate") Set wsOutput = .Sheets("By Facility") Set wsCS_Export = .Sheets("CS_Export") 'Set wsOutput_contract = .Sheets("CS_Export") End With 'Set wbMaster = ActiveWorkbook wbMaster.Worksheets("CS_Export").Visible = True wbMaster.Worksheets("CS_Export").Unprotect "ABC" On Error Resume Next wbMaster.Worksheets("CS_Export").ShowAllData On Error GoTo 0 wbMaster.Worksheets("CS_Export").Range("A2:CZ50000").ClearContents wbMaster.Worksheets("By Facility").Activate wbMaster.Worksheets("By Facility").Unprotect "ABC" wbMaster.Worksheets("By Facility").Columns("J:W").Hidden = False With wsOutput On Error Resume Next .ShowAllData On Error GoTo 0 .AutoFilterMode = False .Range("G4", Range("G" & Rows.count).End(xlUp)).AutoFilter Field:=1, Criteria1:=">0" 'On Error Resume Next .Range("G5", Range("G" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("L2").PasteSpecial xlPasteValues .Range("J5", Range("J" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("B2").PasteSpecial xlPasteValues .Range("W5", Range("W" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("C2").PasteSpecial xlPasteValues .Range("M5", Range("M" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("K2").PasteSpecial xlPasteValues .Range("O5", Range("O" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("AD2").PasteSpecial xlPasteValues .Range("P5", Range("P" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("A2").PasteSpecial xlPasteValues .Range("Q5", Range("Q" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("F2").PasteSpecial xlPasteValues .Range("R5", Range("R" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("G2").PasteSpecial xlPasteValues .Range("S5", Range("S" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("Y2").PasteSpecial xlPasteValues .Range("T5", Range("T" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("BH2").PasteSpecial xlPasteValues .Range("U5", Range("U" & Rows.count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy wbMaster.Worksheets("CS_Export").Range("T2").PasteSpecial xlPasteValues .AutoFilterMode = False 'Exit Sub End With 'With wsCS_Export Dim i As Long For i = wsCS_Export.Range("L" & Rows.count).End(xlUp).Row To 2 Step -1 'MsgBox ("Below I with value " & i) If (wsCS_Export.Range("AD" & i).Value <> "Set") Then 'do nothing Else 'MsgBox ("Below Else of Set") If (wsCS_Export.Range("L" & i).Value = 1) Then 'dp nothing Else wsCS_Export.Rows(i).Copy wsCS_Export.Rows(i).Resize(wsCS_Export.Range("L" & i).Value - 1).Insert End If End If Next i 'End With 'With wsCS_Export 'wsCS_Export.AutoFilterMode = False wsCS_Export.Range("A1:CM100000").AutoFilter Field:=30, Criteria1:="Set" '.Range("A1", Range("AD" & Rows.count).End(xlUp)).AutoFilter Field:=30, Criteria1:="Set" 'On Error Resume Next '.Range("G5", Range("G" & Rows.count).End(xlUp)).SpecialCells(12).EntireRow.Delete 'wsCS_Export.AutoFilterMode = False On Error Resume Next Set rngCS_Export = wsCS_Export.Range("L2:L" & Cells(Rows.count, "L").End(xlUp).Row).Cells.SpecialCells(xlCellTypeVisible) On Error GoTo 0 Dim c1 As Range If rngCS_Export Is Nothing Then 'Set rngCS_Export.Value = 1 'Do Nothing as there is no Set in the order Else ' Setting the value of sets to quantity 1 for each row of set rngCS_Export.Value = 1 End If 'For Each cell In rngCS_Export ' 'MsgBox ("Cell value" & cell.Value) ' cell.Value = 1 ' Next cell On Error Resume Next wbMaster.Worksheets("CS_Export").ShowAllData On Error GoTo 0 'Exit Sub 'lastRow = wbMaster.Worksheets("CS_Export").Range("L1", Worksheets("CS_Export").Range("L1").End(xlDown)).Rows.count 'lastRow = wbMaster.Worksheets("CS_Export").Range("L" & src.Rows.count).End(xlUp).Row 'wbMaster.Worksheets("CS_Export").Range("A2:A" & lastRow).Value = "ZNC" 'wbMaster.Worksheets("CS_Export").Range("G2:G" & lastRow).Value = "N14" 'wbMaster.Worksheets("CS_Export").Range("Y2:Y" & lastRow).Value = "M007" 'wbMaster.Worksheets("CS_Export").Range("F2:F" & lastRow).Value = "S2" 'Dim rw As Integer 'With wbMaster 'Set wsNewDetail = .Sheets.Add Set wbNewWorkbook = Workbooks.Add Set wbNewWorkbook = ActiveWorkbook With wbNewWorkbook MyNewBook = wbNewWorkbook.Name wbMaster.Worksheets("CS_Export").Copy Before:=wbNewWorkbook.Sheets(1) 'ActiveSheet.Paste '.Range("A1").PasteSpecial xlPasteColumnWidths '.PasteSpecial xlPasteValues '.PasteSpecial xlPasteFormats '.Columns("A:I").EntireColumn.NumberFormat = "@" '.Columns("A:I").EntireColumn.AutoFit 'End With End With '.................................................................. 'wsNewDetail.Move after:=wbNewWorkbook.Sheets(1) wbMaster.Worksheets("CS_Export").Protect "ABC" wbMaster.Worksheets("By Facility").Columns("J:W").Hidden = True wbMaster.Worksheets("By Facility").Protect "ABC" wbMaster.Worksheets("CS_Export").Visible = False 'wbMaster.Worksheets("Contract").Activate Dim datim As String datim = Format(CStr(Now), "yyyy_mm_dd_hh_mm") 'MsgBox "Came till after date format" strFileName = "CS_Export_" & strHospital & "_" & datim Set wbNewWorkbook = ActiveWorkbook ActiveWorkbook.Worksheets(1).Activate With wbNewWorkbook 'MsgBox ("Before rename") 'Sheets("Sheet1").Name = "Sheet2" ' Sheets("Matching Input").Name = "Sheet1" 'MsgBox ("After rename") FileSelected = Application.Dialogs(xlDialogSaveAs).Show(strFileName) 'MsgBox "Value of fileselected " & FileSelected If Not FileSelected <> "False" Then 'MsgBox "You have cancelled" wbNewWorkbook.Close False Set wbNewWorkbook = Nothing Exit Sub End If End With With Application .ScreenUpdating = True .DisplayAlerts = False End With Exit Sub Error_handler: MsgBox "An error has occured while processing the file. Please close the file and rerun it, if the problem persists contact the CE support team" Application.Calculation = xlAutomatic End Sub Screenshot of error message: Thank you!
