• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Macro loop

chirayu

chirayu

Well-Known Member
Hi Guys,

Need help with my LOOP code. Also given below is the private sub it is running.

Basically what I want it to do is in column D, there are invoice numbers, It needs to loop through all files in The invoice folder for each invoice in column D. The reason is that the invoice files received have no specific name. Only the contents act as identifiers. so it must go through all invoice files to match against individual cell/ group in column D.

Code: 
'Global Variables
Dim DebsPASPath As String
Dim DebsPASFile As String
Dim DebsPASSheet As String
Dim DebsPASInvoiceFile As String
Dim DebsPASInvoiceSheet As String

Sub DebenhamsPASVerify()

'Please ensure there is an Invoice folder in the same folder as the PAS file.
'Place all the converted excel invoices in that folder before using this macro.

Dim FolderPath As String
Dim FileName As String
Dim OpenInvoice As Workbook

Range("D2").Select

DebsPASPath = ActiveWorkbook.Path
DebsPASFile = ActiveWorkbook.Name
DebsPASSheet = ActiveSheet.Name

FolderPath = DebsPASPath & "\Invoice\"
FileName = Dir(FolderPath & "*.xlsx")

Do While FileName <> ""

  Set OpenInvoice = Workbooks.Open(FolderPath & FileName)
  
  DebsPASInvoiceFile = ActiveWorkbook.Name
  DebsPASInvoiceSheet = ActiveSheet.Name
  
  'NYK Invoice
  Application.Run "Personal.xlsb!DebenhamsPasVerifyNYK"
  
  Workbooks(DebsPASInvoiceFile).Close savechanges:=False
  
  FileName = Dir
Loop

Range("O1").ClearContents
  
MsgBox "Macro completed. Please check values in Red as they are +/- 10 pence of the Ivoice total", vbInformation, ""

End Sub

Private Sub DebenhamsPasVerifyNYK()


Dim Cont As String 'pas container
Dim ContFound As Variant 'find pas container in invoice file
Dim InvNo As String 'pas invoice number
Dim InvNoFound As Variant 'find pas invoice number in invoice file
Dim Masn As String 'pas masn number
Dim MasnFound As Variant 'find pas masn number in invoice file
Dim InvDT As String 'pas invoice date
Dim InvDTFound As Variant 'find pas invoice date in invoice file
Dim VslName As String 'pas vessel name
Dim VslNameFound As Variant 'find pas vessel name in invoice file
Dim FrstRow As String 'first pas masn row for same masn
Dim FrstVal As String 'first pas masn cell value for same masn
Dim LstRow As String 'last pas masn row for same masn
Dim InvVal As Double 'pas total masn invoice cost
Dim InvValFound As Double 'find pas total masn invoice cost in invoice file
Dim InvValDiff As Double '[InValDiff = InVal - InValFound]
Dim InvValMatch As Double 'TRUE if: [InvValDiff = InvValFound] or [InvValMatch < 0.11 AND InvValMatch > -0.11]
Dim Supplier As Variant 'carrier name


Set Supplier = Cells.Find(What:="Nippon Yusen Kabushiki Kaisha", LookIn:=xlValues)


If Not Supplier Is Nothing Then
  
  Windows(DebsPASFile).Activate
  Worksheets(DebsPASSheet).Select
  
  FrstVal = ActiveCell.Value
  
  Do Until FrstVal <> ActiveCell.Value
  
  
  'Calculate First & Last row for same Masn
  '----------------------------------------
  
  Do Until ActiveCell.Value <> ActiveCell.Offset(1, 0).Value
  ActiveCell.Offset(1, 0).Select
  Loop
  LstRow = ActiveCell.Row
  
  Do Until ActiveCell.Value <> ActiveCell.Offset(-1, 0).Value
  ActiveCell.Offset(-1, 0).Select
  Loop
  FrstRow = ActiveCell.Row
  FrstVal = ActiveCell.Value
  
  
  'Sum the costvalue for that Masn
  '-------------------------------
  Range("O1").Formula = "=Sum(H" & FrstRow & ":H" & LstRow & ")"
  InvVal = Range("O1").Value
  
  'Set all the variable to be matched individually against invoice file
  '--------------------------------------------------------------------
  Cont = Range("F" & ActiveCell.Row).Value
  InvNo = Left(Range("D" & ActiveCell.Row).Value, 3) & " " & Right(Range("D" & ActiveCell.Row).Value, 7)
  Masn = Range("C" & ActiveCell.Row).Value
  InvDT = Format(Range("E" & ActiveCell.Row).Value, "dd mmm yyyy")
  VslName = Range("B" & ActiveCell.Row).Value
  
  
  'Go to Invoice file
  '------------------
  Windows(DebsPASInvoiceFile).Activate
  Worksheets(DebsPASInvoiceSheet).Select
  
  
  'Remove "Vessel Voyage Bound" from merging with the Vessel Name
  '--------------------------------------------------------------
  Cells.Replace What:="VESSEL VOYAGE", Replacement:=" ", LookAt:=xlPart, _
  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
  ReplaceFormat:=False
  Cells.Replace What:="BOUND", Replacement:=" ", LookAt:=xlPart, _
  SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
  ReplaceFormat:=False
  
  
  'Set the container & vessel variable to be matched automatically against invoice file
  '------------------------------------------------------------------------------------
  Set ContFound = Cells.Find(What:=Cont, LookIn:=xlFormulas)
  Set VslNameFound = Cells.Find(What:=VslName, LookIn:=xlFormulas)
  
  If Not ContFound Is Nothing And Not VslNameFound Is Nothing Then
  
  Cells.Find(What:="AMOUNT DUE", LookIn:=xlFormulas).Activate
  Selection.End(xlToRight).Select
  InvValFound = ActiveCell.Value
  
  Cells.Find(What:="ISSUE DATE", LookIn:=xlFormulas).Activate
  Selection.End(xlToRight).Select
  InvDTFound = ActiveCell.Value
  
  Cells.Find(What:="INVOICE NO.", LookIn:=xlFormulas).Activate
  Selection.End(xlToRight).Select
  InvNoFound = ActiveCell.Value
  
  Cells.Find(What:="REFERENCE", LookIn:=xlFormulas).Activate
  Selection.End(xlDown).Select
  MasnFound = ActiveCell.Value
  
  'Check if InvVal is +/-10pence of the InvValFound
  '------------------------------------------------
  InvValDiff = InvVal - InvValFound
  
  If InvVal = InvValFound Then
  InvValMatch = True
  ElseIf InvValDiff < 0.11 And InvValDiff > -0.11 Then
  InvValMatch = True
  Else
  InvValMatch = False
  End If
  
  
  'Go to PAS file
  '--------------
  Windows(DebsPASFile).Activate
  Worksheets(DebsPASSheet).Select
  
  
  'Check if manual variables match & then colour
  '---------------------------------------------
  If InvValMatch = True _
  And InvDT = InvDTFound _
  And InvNo = InvNoFound _
  And Masn = MasnFound Then
  Range("H" & FrstRow & ":H" & LstRow).Interior.Color = RGB(146, 208, 80) 'Green is Good
  Else
  Range("H" & FrstRow & ":H" & LstRow).Interior.Color = RGB(255, 0, 0) 'Red is Bad
  End If
  Range("C" & LstRow).Select
  ActiveCell.Offset(1, 0).Select
  Else
  Windows(DebsPASFile).Activate
  Worksheets(DebsPASSheet).Select
  Range("D" & LstRow).Select
  ActiveCell.Offset(1, 0).Select
  End If
  
  
  Loop

Else
End If

End Sub
 
Hi chirayu,
You haven't uploaded the file or an invoice example, so I can't test easily, and you haven't said what your problem is. Please elaborate!
:)
 
PFA sample data for the main file in which invoices will be listed
 

Attachments

  • SAMPLE.xlsx
    11.7 KB · Views: 0
Hi chirayu, I'm still not sure what the problem is, or exactly what you are trying to do.
 
Basically my Main code "DebenhamsPASVerify" is a Loop code.

It opens all the excel Invoice files in a folder named 'Invoice' & matches them against a given cell value in Column D of the sample file.

If the value matches then it runs the sub macro 'DebenhamsPasVerifyNYK'.

Otherwise it moves onto next unique cell value & closes the opened invoice file.

Repeat loop till match is found for all unique cell values.
---

The issue I am having is that I want it to loop through all files for every unique cell value in Column D.

Currently the loop code only performs the loop once e.g.
- My 'Invoice' folder has 10 excel invoices.
- My sample file has 2 unique values in column D of sample file
- Loop start > First 5 files don't match so closed
- File 6 matches with 1st unique value in column D of sample file > Sub macro run
- Move to next unique value in column D of sample file

^Here it should loop through all 10 files again from the 'Invoice' folder for current unique cell value in column D of sample file, but it starts at file 7 in 'Invoice' folder, so my Macro ends prematurely.
 
Hi chirayu,
without the same set of files as you I can't really test, but looking atr your code and your description, I understand the problem.
I don't know of a way to reset the file iteration from within the loop, but I think this may work (not tested):
Code: 
Sub DebenhamsPASVerify()

'Please ensure there is an Invoice folder in the same folder as the PAS file.
'Place all the converted excel invoices in that folder before using this macro.

Dim FolderPath As String
Dim FileName As String
Dim OpenInvoice As Workbook
Dim numcount As Integer
Dim activerow As Integer

Range("D2").Select
activerow = 2
numcount = 1
DebsPASPath = ActiveWorkbook.Path
DebsPASFile = ActiveWorkbook.Name
DebsPASSheet = ActiveSheet.Name


For numcount = 1 To Application.CountA(ActiveSheet.Range("D2:D999")) + 1

FolderPath = DebsPASPath & "\Invoice\"
FileName = Dir(FolderPath & "*.xlsx")

Do While FileName <> ""

  Set OpenInvoice = Workbooks.Open(FolderPath & FileName)
  DebsPASInvoiceFile = ActiveWorkbook.Name
  DebsPASInvoiceSheet = ActiveSheet.Name
  'NYK Invoice
  Application.Run "Personal.xlsb!DebenhamsPasVerifyNYK"
  If ActiveCell.Row > activerow Then
    activerow = activerow + 1
    Workbooks(DebsPASInvoiceFile).Close savechanges:=False
    Exit Do
  End If
  Workbooks(DebsPASInvoiceFile).Close savechanges:=False
  FileName = Dir
Loop
Next


Range("O1").ClearContents
MsgBox "Macro completed. Please check values in Red as they are +/- 10 pence of the Ivoice total", vbInformation, ""

End Sub

Also, you could put the loop which iterates through the files inside your macro which iterates through numbers instead of the other way around. this way, each new number triggers a run through the loop which trys all files, and you can just exit early if it finds what it is looking for.
I hope this makes sense and is helpful!
 
You must log in or register to reply here.
Back
Top