Posts by Raider52

Raider52 · Dec 24th 2021

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

Raider52 · Dec 23rd 2021

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

Raider52 · Jul 4th 2020

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

Raider52 · Jul 4th 2020

Code

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

Raider52 · May 27th 2020

Hello All:

Code

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.

Raider52 · May 17th 2020

Wow! Thanks royUK... Works like a charm. Now I understand the code logic.

Many thanks... Again

Raider52 · May 17th 2020

See Attached Workbook.

Again, I need to convert each value in Column B to a hyperlink.

Thanls

Raider52 · May 17th 2020

Code

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)"

Raider52 · May 17th 2020

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

Raider52 · May 17th 2020

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.

Code: RA-Code

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

Raider52 · May 16th 2020

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

Raider52 · May 7th 2020

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

Raider52 · Apr 27th 2020

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,

Raider52 · Apr 26th 2020

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")

Raider52 · Apr 26th 2020

Code

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:-(

Raider52 · Apr 26th 2020

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

Raider52 · Apr 26th 2020

Code

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.

Raider52 · Apr 22nd 2020

Code

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.

Code

ActiveWorkbook.Close

Raider52 · Apr 21st 2020

Code

Application.Run (wbTarget.Name & "!Make1RowPDF")
MsgBox "YOU ARE HERE!!!!!!"
'GoTo UFinn

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.

Raider52 · Apr 20th 2020

Code

>>>>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

Posts by Raider52

Why I cannot see the code for some Modules in Developer tab in Excel

Why I cannot see the code for some Modules in Developer tab in Excel

how can I create an xml schema to import multiple xml files into a single Excel worksheet using vba

how can I create an xml schema to import multiple xml files into a single Excel worksheet using vba

How to Extract Tables from A Series of Outlook Emails

I need help Converting A list of File Paths in Excel to HyperLinks Using VBA

I need help Converting A list of File Paths in Excel to HyperLinks Using VBA

I need help Converting A list of File Paths in Excel to HyperLinks Using VBA

I need help Converting A list of File Paths in Excel to HyperLinks Using VBA

I need help Converting A list of File Paths in Excel to HyperLinks Using VBA

I need help Converting A list of File Paths in Excel to HyperLinks Using VBA

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

Unable to Activate HyperLink Calculation ("=HyperLink("+"L:\Folder\SubFolder\Filename.jpg+")"

Unable to Activate HyperLink Calculation ("=HyperLink("+"L:\Folder\SubFolder\Filename.jpg+")"

Unable to Activate HyperLink Calculation ("=HyperLink("+"L:\Folder\SubFolder\Filename.jpg+")"

Unable to Activate HyperLink Calculation ("=HyperLink("+"L:\Folder\SubFolder\Filename.jpg+")"

Unable to Activate HyperLink Calculation ("=HyperLink("+"L:\Folder\SubFolder\Filename.jpg+")"

How Return to Calling VBA Code after Application.Run

How Return to Calling VBA Code after Application.Run

How Return to Calling VBA Code after Application.Run