Yes the code runs fine. I just cannot view and/or edit the code because it is hidden. Some Modules are visible. I closed all the modules, but still, only a few will open for editing... Very strange
Thanks for your reply
Al
Yes the code runs fine. I just cannot view and/or edit the code because it is hidden. Some Modules are visible. I closed all the modules, but still, only a few will open for editing... Very strange
Thanks for your reply
Al
Hello All:
I am frustrated with a problem I never experienced using VBA code in Excel. I have developed over 40 Modules in Excel .xlsm file. For some reason, when I share the Excel .xlsm file via Dropbox, I cannot see the code for SOME (most) Modules in Developer tab in Excel. A few additional points:
1. I am running Excel in Windows 11 and can see everything (all modules, all code).
2. I Share the Excel file via Dropbox with another Excel users who is running Windows 10.
3. Thare are other user downloads the problematic Excel .xlsm file to his laptop and we view the file using Zoom
4. There are other shared Excel .xlsm files where this is not a problem at all
Any help/guidance will be much appreciated.
Many Thanks
Al
I have added an Excel sheet to help clarify my request. Note that I an trying import multiple xml files to a single Excel worksheet. Not all the xml files will contain the same fields as the Master Schema. So I need to ensure the xml files with fewer column will adjust appropriately to the Master Schema.
Hope someone can nudge me along.
Thanks
Sub Impor_XML_Data1()
'Code By Al
Application.ScreenUpdating = False
Dim FSO As Object
Dim objFs As Object
Dim objFolder As Object
Dim TargetSheet As Worksheet
Dim ChooseFIle As Variant
Dim TargetSheetName As String
Dim TargetCellAddress As String
Dim NextRow As Long
Dim XName As String
Dim Maps As XmlMaps
Dim XMap As XmlMap
Set objFs = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFs.GetFolder("C:\Users\Owner\Documents\Documents\PITCO\EDI\Assessment\")
Set TargetSheet = ThisWorkbook.Sheets("Sheet1")
Set Maps = ActiveWorkbook.XmlMaps
TargetCellAddress = "A1"
TargetSheet.UsedRange.Clear
NextRow = 1
Worksheets("Sheet1").Select
For Each file In objFolder.Files
XName = file.Name
If objFs.GetExtensionName(file) = "xml" Then
GoTo UDoIt
Else: GoTo GetNext
End If
UDoIt:
Set XMap = "Invoice_Map"
If NextRow = 1 Then
TargetCellAddress = "A1"
Else
'
TargetCellAddress = "A" & NextRow
End If
'
ChooseFIle = "C:\Users\Owner\Documents\Documents\PITCO\EDI\Assessment\" & XName
' If ChooseFIle = vbNullString Then Exit Sub
ThisWorkbook.XmlImport Url:=ChooseFIle, ImportMap:=XMap, Overwrite:=True, Destination:=TargetSheet.Range(TargetCellAddress)
NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
Set ImportMap = Nothing
GetNext:
Next
' MsgBox "Import Done"
UDone:
Set XMap = Nothing
Application.ScreenUpdating = True
End Sub
Display More
Hello All:
Firstly, I am still learning VBA. I am trying to import many xml files into a single Excel worksheet, and there are subtle difference between the xml files. These are EDI Invoice files from a single EDI provider, and the data schema is pretty much identical, but in some cases some vendors do not include certain variable, such as discounts or notes and the files are excluded from the xml files.
What I would like to do is build a Master schema (what I call "Invoice_Map" in the attached Source Code) and write a VBA script which loops through all the XML files and have the data map to the Excel Worksheet based on the master schema fields, which are available within each of the xml files. I have tried to accomplish this without success.
The best I have been able to accomplish is to get VBA to import all the xml files to a single Excel worksheet an load based on each of the xml maps for each xml file.
Please help or provide some sample code which I can modify for my purpose. I really like this forum and I am grateful for any help.
Many thanks in advance
Hello All:
Sub getTableDataFromOutlook()
'Declare our Variables
Dim oLookInspector As Inspector
Dim oLookMailItem As MailItem
'Declare our Variables
Dim oLookWordDoc As Word.Document
Dim oLookWordTbl As Word.Table
'Declare our Excel Variables
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrkSheet As Excel.Worksheet
'Grab the mail item
Set oLookMailItem = Application.ActiveExplorer.CurrentFolder.Items("Auto-Stop Workflow Alert")
'Grab the active inspector
Set oLookInspector = oLookMailItem.GetInspector
'Grab the Word Editor Objec, this returns the Word Object Model.
Set oLookWordDoc = oLookInspector.WordEditor
'Create a new Excel Application
'Set xlApp = New Excel.Application
'Grab the Active instance
Set xlApp = GetObject(, "Excel.Application")
'Make the Excel Application Visible
xlApp.Visible = True
'Add a new workbook
Set xlBook = xlApp.Workbooks.Add
'Add a new worksheet
Set xlWrkSheet = xlBook.Worksheets.Add
'Grab the Word Table
Set oLookWordTbl = oLookWordDoc.Tables(1)
'copy the Table
oLookWordTbl.Range.Copy
'Paste it to the worksheet
xlWrkSheet.Paste Destination:=xlWrkSheet.Cells(1, 1)
End Sub
Display More
Hello All:
From an Internet search, I found the attached code for extracting Table Data from a single Outlook email, which works very well. I have not figured out how to loop through a series of emails containing the same table format and load all data for all tables to a single Excel worksheet. Once I have loaded all the history, I want to execute the VBA script daily to pick up new incoming table data to update the Excel file.
If anyone can provide hints how to convert my single use VBA code to looping code, including the "xlUp function" to append data to the bottom of the last updated worksheet, I would be more that appreciative.
Many thanks in advance.
Wow! Thanks royUK... Works like a charm. Now I understand the code logic.
Many thanks... Again
See Attached Workbook.
Again, I need to convert each value in Column B to a hyperlink.
Thanls
Sub AddHyperlink()
Dim rRng As Range, rCl As Range
Dim iX As Integer
ThisWorkbook.Sheets("ActivateHLinks").Activate
With ActiveSheet
Set rRng = .Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp))
For Each rCl In rRng.Cells
'
.Hyperlinks.Add rCl.Offset(, -2), Address:=rCl.Value, TextToDisplay:="Link to"
'MsgBox rCl
Next rCl
End With
End Sub
Display More
Here is the full code as modified keeping ".Hyperlinks.Add rCl.Offset(, -2)"
Yes... When is use ".Hyperlinks.Add rCl.Offset(, -2)", I get Run-tine error '1004' -- Application-define or object-defined error. If I change that to: .Hyperlinks.Add rCl.Offset(, -1), it seems to cyclye through all 300 rows of file locations in the list, but it does not convert the file locations to hyperlinks.
Please stay with me until I crack this...
Much appreciated
Sorry... I have attached my code now. Rm regarding the code you shared, is the missing code on lines 4 and 5. Please advise and thanks for your help. I think I am getting close to figuring it out.
Sub Convert2HyperLink()
'Don't show changes on worksheet to user, this will speed up the macro a lot
Application.ScreenUpdating = False
Dim RctX As Long
Dim Cct3 As Long
Dim StartCell As Object
'Dimension variables and declare data types
Dim Value As String
'Dim WS As Worksheet
Set StartCell = Worksheets("ActivateHLinks").Range("B2")
RctX = Worksheets("ActivateHLinks").Cells(Rows.Count, 2).End(xlUp).Row
' Cct3 = 2
For Cct3 = 2 To RctX
'Set StartCell = Worksheets("ActivateHLinks").Range("B" & Cct3)
'Get filename from files in folder sPath
Value = Worksheets("ActivateHLinks").Cells(Cct3, 2).Value
'Check if value is equal to your workbook name or a temporary file that is created when the workbook is opened
If Len(Value) > 2 Then
Set StartCell = StartCell.Offset(1, 0)
'Create hyperlink
StartCell.Hyperlinks.Add Anchor:=StartCell, Address:= _
Value, TextToDisplay:=Value
'Move to cell below
Cct3 = Cct3 + 1
'
Set StartCell = StartCell.Offset(, 0)
'
End If
Next
'Show changes on worksheet to user
Application.ScreenUpdating = False
End Sub
Display More
I am trying to debug this VBA Code to convert a list of about 300 or more File locations to HyperLinks using VBA. The attached code works, but either converts every other Row of Half the Rows in the list. It has to do with how I am using the StartCell and StartCell.Offset, but I cannot figure it out. And I cannot fine any VBA code without StartCell function.
The Row of Cell Values are like the list, below... Any help would be appreciated... Thanks
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 04 02 20_page_03.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 03 30 20_page_34.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 03 30 20_page_42.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 03 30 20_page_50.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 03 31 20_page_08.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 03 31 20_page_16.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 03 31 20_page_24.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 03 31 20_page_32.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 03 31 20_page_40.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 03 31 20_page_48.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 04 01 20 through 04 02 20_page_06.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 04 01 20 through 04 02 20_page_14.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 04 01 20 through 04 02 20_page_22.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 04 01 20_page_03.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 04 01 20_page_11.jpg |
C:\Users\Owner\Documents\Documents\PITCO\Wells Fargo\ChkImages2\WFB 04 01 20_page_19.jpg |
Hello All:
I am trying to figure out How to Calculate the first and last date of a Month Using VBA Code when the Month and Year is Pulled from Cells in Excel. An additional intrigue is I need the resulting calculation to look like so:
1+yy+mm+dd
For Example May 2020:
first date = 1200501, as Text
last date = 1200531, , as Text
Of Course, I hope VBA is smart enough to handle leap years.
Sample VBA code would be much appreciated.
Many Thanks
The second option would be a non-started. Each .jpg image is quite large, so post it to Excel would be quite bulky.
As I understand the first option, the code cycles through all the object (.jpg) files and copy the address as a hyperlink in Excel... Right. Seems feasible, but there are quite a number of other attributes on each record in the large file, and I would need to employ some complex logic to ensure the Hyperlink is posting to the correct record.
I just believe I am missing something very simple to get VBA to activate the calculated hyperlink. Manually double clicking the cell and pressing enter does the job. Cannot understand why the ActiveSheet.Hyperlinks.Add myCell, myCell.Value in vba is not doing the job. I did notice in your procedure you have an option Anchor:=Selection. What is this option? Should I try adding it to my code?
Thanks,
The Code is nor showing an error the data, below is a subset of the data in Column I which I am trying to get vba to covert to hyperlink to a folder/file location. The "=HyperLink" should not show after vba converts the value to a hyperlink. It works manually cell by cell, but I want vba to do it , because larger files will be coming in great frequency in future.
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_01.jpg") |
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_02.jpg") |
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_03.jpg") |
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_04.jpg") |
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_05.jpg") |
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_06.jpg") |
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_07.jpg") |
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_08.jpg") |
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_09.jpg") |
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_10.jpg") |
=HyperLINK("L:\2020\04 2020 April xxxxx xxxxx xxxxxx\WFB 04 01 20_page_11.jpg") |
Sub ActivateHLinks()
Dim FileName As String
Dim RctX As Long
Dim src5 As Workbook ' THE Invoice WORKBOOK.
Dim Rct3 As Long
Dim Cct3 As Long
Dim CAddr3 As String
Dim Rgx3 As String
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
ThisWorkbook.Sheets("WFB_StatementDetail").Activate
RctX = Cells(Rows.Count, 9).End(xlUp).Row
For Each myCell In Range("I2:I" & RctX)
ActiveSheet.Hyperlinks.Add myCell, myCell.Value
Next myCell
'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Display More
I took the Filename formula out of play by importing the Hyperlink Module into the workbook containing the hyperlink calculation. I have attached the simplified code. Same result:-(
Don't think the Filename formula is the problem. the code I loaded reflected opening the target Workbook/Worksheet from another Workbook. I imported the same code to the target Workbook where the Filename formula is not required. I get the same result... the activate code snippet runs by the resulting hyperlink does not work.
Any other suggestions.
Thanks
Sub ActivateHLinks()
Dim FileName As String
Dim RctX As Long
Dim src5 As Workbook ' THE Invoice WORKBOOK.
Dim Rct3 As Long
Dim Cct3 As Long
Dim CAddr3 As String
Dim Rgx3 As String
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
FileName = "L:\" & Mid(ThisWorkbook.Sheets("Sheet2").Cells(2, 9), 4, 4) & "\" & _
ThisWorkbook.Sheets("Sheet2").Cells(2, 9) & "\" & _
Left(ThisWorkbook.Sheets("Sheet2").Cells(2, 9), 8) & "WFB_StatementDetail.xlsx"
Set src5 = Workbooks.Open(FileName, True, True)
'Stop
If FileName = VBA.Constants.vbNullString Then
MsgBox "File: " & FileName & " Does Not Exist" & vbNewLine & _
"Please Run the Monarch Automation Again..."
Else
src5.Sheets("WFB_StatementDetail").Activate
RctX = Cells(Rows.Count, 9).End(xlUp).Row
For Each myCell In Range("I2:I" & RctX)
ActiveSheet.Hyperlinks.Add myCell, myCell.Value
Next myCell
'
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Display More
Hello All:
I have an Excel file with several hundred calculated hyperlinks using a formula link: HyperLink Calculation ("=HyperLink("+"L:\Folder\SubFolder\Filename.jpg+"). I found a vba code snippet: ActiveSheet.Hyperlinks.Add myCell, myCell.Value, which seems to activate the formulas (full vba code attached), but which I click on the resulting hyperlink I get error saying the target file cannot be found.
Without running the VBA script, I can open the same file, double click each cell and press enter and the hyperlink works as expected. The code is not making any change other that activating the hyperlink. Also note that the cell still shown the full formula (i.e., the =hyperlink part is still visible. When I click inside the cell value and press enter, the =hyperlink part is no longer visible, but I get the same error. Is seems something is there that causing the problem, but I cannot determine the problem.
Any ideas???
Thanks for any help.
ActiveWorkbook.Save
ActiveWorkbook.SaveAs FileName:="V:\BankStatementFiles\PDFX_Summary.xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Closeapplication.DisplayAlerts = True
'Stop
End Sub
I found the problem... The problem was I was closing the called Workbook with the statement, below. That also terminated the calling procedure. When I commented out the statement below, the return to calling procedure completed the remainder of the processing.
Thanks to both of you for your help... Stay Safe.
When I put a MsgBox just after the Application.Run call, the message never appears, which tells me the return from !Make1RowPDF terminates the calling procedure (SingleRowPDF). So SingleRowPDF never executed the Call FinalOne 'Module 4 statement. There has to be something wrong within Make1RowPDF, although it does all I want it to do. Make1RowPDF never returns control to SingleRowPDF.
>>>>This Is the Calling Procedure>>>>>>>>>
Sub SingleRowPDF()
Application.DisplayAlerts = False
Dim PathToFile As String, _
NameOfFile As String, _
wbTarget As Workbook, _
CloseIt As Boolean
'
'Set file name and location. You will need to update this info!
NameOfFile = "PDF_Summary.xlsm"
PathToFile = "V:\BankStatementFiles"
'
'Attempt to set the target workbook to a variable. If an error is
'generated, then the workbook is not open, so open it
On Error Resume Next
Set wbTarget = Workbooks(PDF_Summary.xlsm)
If Err.Number <> 0 Then
'Open the workbook
Err.Clear
Set wbTarget = Workbooks.Open(PathToFile & "\" & NameOfFile)
CloseIt = True
End If
'Check and make sure workbook was opened
If Err.Number = 1004 Then
MsgBox "Sorry, but the file you specified does not exist!" _
& vbNewLine & PathToFile & "\" & NameOfFile
Exit Sub
End If
On Error GoTo 0
'Run the macro! (You will need to update "MacroName" to the
'name of the macro you wish to run)
Application.Run (wbTarget.Name & "!Make1RowPDF")
GoTo UFinn
If CloseIt = True Then
'If the target workbook was opened by the macro, close it
wbTarget.Close savechanges:=False
Else
'If the target workbook was already open, reactivate this workbook
ThisWorkbook.Activate
End If
'
Application.DisplayAlerts = True
UFinn:
'
Call FinalOne 'Module 4
End Sub
>>>>>>>This Is the Called Procedure (Partial)>>>>>>>>>>>
Sub Make1RowPDF()
Application.DisplayAlerts = False
'GoTo CheckThis
Dim CheckNo As String
Dim iCntr As String
Dim i As Integer
Dim wrksht1 As Worksheet
Dim wrksht2 As Worksheet
'
Set FSO = CreateObject("Scripting.FileSystemObject")
'Dim src As Workbook ' THE Invoice WORKBOOK.
'Dim src4 As Workbook ' THE Invoice WORKBOOK.
'Set src = Workbooks.Open("V:\BankStatementFiles\PDF_Summary.xlsx", True, True)
'
Set wrksht2 = ThisWorkbook.Worksheets("BStmt1Row")
wrksht2.Visible = xlSheetVisible
wrksht2.Activate
' ThisWorkbook.Worksheets("BStmt1Row")
ERow = wrksht2.Cells(Rows.Count, 1).End(xlUp).Row
iCntr = "A2:" & "AF" & ERow
wrksht2.Range(iCntr).EntireRow.Delete
'
'Stop
'
Set wrksht1 = ThisWorkbook.Worksheets("BStmtDetail")
wrksht1.Visible = xlSheetVisible
wrksht1.Activate
LstRow = wrksht1.Cells(Rows.Count, 1).End(xlUp).Row + 1
'
DRank = 2
Filex = "Junk"
PageNx = 9999
'
For i = 2 To LstRow
If i = 2 Then
GoTo UStart
ElseIf Filex = FileName And PageNx = PageNo Then
Rank = Worksheets("BStmtDetail").Cells(i, 7)
GoTo GitMore
End If
Worksheets("BStmt1Row").Cells(DRank, 1) = SoureFile
Worksheets("BStmt1Row").Cells(DRank, 2) = FileName
Worksheets("BStmt1Row").Cells(DRank, 3) = PageNo
Worksheets("BStmt1Row").Cells(DRank, 4) = PrintDate
Worksheets("BStmt1Row").Cells(DRank, 5) = CheckNo
Worksheets("BStmt1Row").Cells(DRank, 6) = Amt
Worksheets("BStmt1Row").Cells(DRank, 7) = ChkDetail
Worksheets("BStmt1Row").Cells(DRank, 8) =
Worksheets("BStmt1Row").Cells(DRank, 28) = BaiCode
Worksheets("BStmt1Row").Cells(DRank, 29) = OneDayF
Worksheets("BStmt1Row").Cells(DRank, 30) = CeoID
Worksheets("BStmt1Row").Cells(DRank, 31) = CreatedBy
Worksheets("BStmt1Row").Cells(DRank, 32) = AddlItmDtl
DRank = DRank + 1
'
UStart:
SoureFile = Worksheets("BStmtDetail").Cells(i, 10)
FileName = Worksheets("BStmtDetail").Cells(i, 11)
PageNo = Worksheets("BStmtDetail").Cells(i, 1)
PrintDate = Worksheets("BStmtDetail").Cells(i, 2)
ChkDetail = Worksheets("BStmtDetail").Cells(i, 3)
Rank = Worksheets("BStmtDetail").Cells(i, 7)
CheckNo = Worksheets("BStmtDetail").Cells(i, 8)
Amt = Worksheets("BStmtDetail").Cells(i, 9)
' CheckAmt = Worksheets("BStmtDetail").Cells(i, 5)
GoTo Nudder
GitMore:
' Rank = Worksheets("BStmtDetail").Cells(i, 7)
If Rank = 2 Then
GoTo Git02
ElseIf Rank = 3 Then
GoTo Git03
ElseIf Rank = 4 Then
GoTo Git04
ElseIf Rank = 5 Then
GoTo Git05
ElseIf Rank = 6 Then
GoTo Git06
ElseIf Rank = 7 Then
ElseIf Rank = 24 Then
GoTo Git24
ElseIf Rank = 25 Then
GoTo Git25
End If
Git02:
' Amt = Worksheets("BStmtDetail").Cells(i, 9)
CheckAmt = Worksheets("BStmtDetail").Cells(i, 5)
GoTo Nudder
Git03:
AcctNo = Worksheets("BStmtDetail").Cells(i, 5)
GoTo Nudder
Git04:
Eisn = Worksheets("BStmtDetail").Cells(i, 5)
BaiCode = Worksheets("BStmtDetail").Cells(i, 5)
GoTo Nudder
Git22:
OneDayF = Worksheets("BStmtDetail").Cells(i, 5)
GoTo Nudder
Git23:
CeoID = Worksheets("BStmtDetail").Cells(i, 5)
GoTo Nudder
Git24:
CreatedBy = Worksheets("BStmtDetail").Cells(i, 5)
GoTo Nudder
Git25:
AddlItmDtl = Worksheets("BStmtDetail").Cells(i, 5)
Nudder:
Filex = Worksheets("BStmtDetail").Cells(i, 11)
PageNx = Worksheets("BStmtDetail").Cells(i, 1)
Next
'
Worksheets("BStmt1Row").Cells(DRank, 1) = SoureFile
Worksheets("BStmt1Row").Cells(DRank, 2) = FileName
Worksheets("BStmt1Row").Cells(DRank, 3) = PageNo
Worksheets("BStmt1Row").Cells(DRank, 4) = PrintDate
Worksheets("BStmt1Row").Cells(DRank, 5) = CheckNo
Worksheets("BStmt1Row").Cells(DRank, 6) = Amt
DepositID
Worksheets("BStmt1Row").Cells(DRank, 22) = Description
Worksheets("BStmt1Row").Cells(DRank, 23) = ItemSeqNo
Worksheets("BStmt1Row").Cells(DRank, 24) = BankID
Worksheets("BStmt1Row").Cells(DRank, 25) = Location
Worksheets("BStmt1Row").Cells(DRank, 26) = ItemSeq
Worksheets("BStmt1Row").Cells(DRank, 27) = BankID
Worksheets("BStmt1Row").Cells(DRank, 28) = BaiCode
Worksheets("BStmt1Row").Cells(DRank, 29) = OneDayF
Worksheets("BStmt1Row").Cells(DRank, 30) = CeoID
Worksheets("BStmt1Row").Cells(DRank, 31) = CreatedBy
Worksheets("BStmt1Row").Cells(DRank, 32) = AddlItmDtl
UFinn:
'Stop
ActiveWorkbook.Save
ActiveWorkbook.SaveAs FileName:="V:\BankStatementFiles\PDFX_Summary.xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWorkbook.Close
Application.DisplayAlerts = True
'Stop
End Sub
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
The Called Procedure "Make1Row" has been edited to shorten because it was very long. The Calling Procedure has not been edited. Thanks very much for your help
Display More