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

Excel VBA - Can't add code or call another Macro after Next loop!!!

L

Lee Francis

New Member
Hi Guys,


I hope you can help


I have some code which works fine but doesn't fully complete the task at hand. I need to either add to this code or call another macro to complete the job.


I'm struggling to do this. Each time I try I am failing. The last function of the code is a next loop and I think that when I try to call the macro at the end of the sub it is simply looping backthrough the next loop.


Has anyone experienced this before or can you help with this?


I have pasted the code below and I can send the spreadsheet to anyone who needs to see in detail


Thanks for your help guys


Lee

Sub CommandButton1_Click()
Sheets(2).Visible = xlVeryHidden
Dim a, b, c, ws, wb, d, e, f, i
On Error GoTo err

d = Split(Sheets(2).Range("D1").Value, ";")

a = WorksheetFunction.Match(Sheets(1).Range("B3").Value, Sheets(2).Range("B:b"), 0)
If Len(a) = 1 Then
a = "0" & WorksheetFunction.Match(Sheets(1).Range("B3").Value, Sheets(2).Range("B:B"), 0)
End If
If Len(Sheets(1).Range("B4").Value) = 1 Then a = "0" & Sheets(1).Range("B4").Value & "." & a
If Len(Sheets(1).Range("B4").Value) = 2 Then a = Sheets(1).Range("B4").Value & "." & a
a = a & "." & Sheets(1).Range("B2").Value & ".xlsx"

b = Sheets(1).Range("B5").Value
If b = "" Then b = "."

If Right(b, 1) <> "" Then b = b & ""

Sheets(2).Range("E:E").ClearContents

Call dirfiles(b)

c = Sheets(2).Range("E65536").End(xlUp).Row
If c = 1 Then GoTo nofiles

For Each cell In Sheets(2).Range("E1:E" & c)
If Right(cell.Value, 15) <> a Then cell.Value = ""
Next
a = Left(a, Len(a) - 5)

Application.DisplayAlerts = False

On Error Resume Next
Sheets(a).Delete
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = a
Application.DisplayAlerts = True
Sheets(a).Range("A1").Value = "DDR vs QM for " & a
Sheets(a).Range("A1").EntireColumn.ColumnWidth = 12
Sheets(a).Range("A3").Value = "Delivery Note Number"
Set ws = Sheets(a)
ws.Activate

For Each ccel In Sheets(2).Range("E1:E" & c)
If ccel.Value = "" Then GoTo nextccel
wb = ccel.Value
Workbooks.Open Filename:=b & wb, UpdateLinks:=False, ignorereadonlyrecommended:=True
Workbooks(wb).Sheets(1).UsedRange.MergeCells = False
i = 1
For i = 1 To 5
Set e = Workbooks(wb).Sheets(d(i)).UsedRange.Find(What:="Delivery Note", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
f = e.Row + 1
e = Mid(e.Address, InStr(e.Address, "$") + 1, InStr(2, e.Address, "$") - 2)
Workbooks(wb).Sheets(d(i)).Range(e & f & ":" & e & Workbooks(wb).Sheets(d(i)).Range(e & "65536").End(xlUp).Row).Copy
ThisWorkbook.Sheets(a).Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Next i
Workbooks(wb).Close savechanges = False

nextccel:
Next ccel

ThisWorkbook.Sheets(a).Range("A2").Select

Exit Sub

nofiles:
MsgBox "No files with name " & Chr(34) & "*" & a & Chr(34) & " in folder " & Chr(34) & b & Chr(34) & " found. Nothing processed."
Exit Sub

err:
MsgBox err.Description
End Sub

Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$3" Then
If Target.Value = "February" And Target.Offset(1, 0).Value > 28 Then Target.Offset(1, 0).Value = 28
If Target.Value = "April" And Target.Offset(1, 0).Value > 30 Then Target.Offset(1, 0).Value = 31
If Target.Value = "June" And Target.Offset(1, 0).Value > 30 Then Target.Offset(1, 0).Value = 31
If Target.Value = "September" And Target.Offset(1, 0).Value > 30 Then Target.Offset(1, 0).Value = 31
If Target.Value = "November" And Target.Offset(1, 0).Value > 30 Then Target.Offset(1, 0).Value = 31
End If
If Target.Address = "$B$4" Then
If Target.Value = 31 And Target.Offset(-1, 0).Value = "November" Then Target.Value = 30
If Target.Value = 31 And Target.Offset(-1, 0).Value = "September" Then Target.Value = 30
If Target.Value = 31 And Target.Offset(-1, 0).Value = "June" Then Target.Value = 30
If Target.Value = 31 And Target.Offset(-1, 0).Value = "April" Then Target.Value = 30
If Target.Value > 28 And Target.Offset(-1, 0).Value = "February" Then Target.Value = 28
End If
End Sub

Sub dirfiles(b)
Set myobject = New Scripting.FileSystemObject
Set mysource = myobject.getfolder(b)
On Error Resume Next
irow = 2
For Each myfile In mysource.Files
Sheets(2).Cells(irow, 5).Value = myfile.Name
irow = irow + 1
Next

End Sub
 
Lee


A few comments


You should try and use descriptive variables in your code, as although you remember what d represents now, I'll bet in 2 years time you have no idea


You should indent your code using Tab in the VBA editor, This makes following logical loops a lot easier

In the Forums simply put a ` in front of and after the code to maintain the indents

I have done it for you above


You should have some comments even if they tell us what each block of code is doing, it makes debugging a lot simpler


Finally, Can you tell us where the issue you describe is?

What happens and what should happen
 
Hi Hui


Thanks for coming back to me.


I'll be sure to follow your instructions in future.


The problem is that when I try to call another macro by entering "call macroname" just before End Sub it fails.


I have done this many times before but this is the first time I have had a problem. The next loop above end sub seems to be causing the problem


Thanks again for taking the time to look at this


Lee
 
Lee


Can you please check what your saying


There is only 1 call line in your code

Code: 
Call dirfiles(b)

Which is not before End Sub ?

It is just under

[pre]Sheets(2).Range("E:E").ClearContents

Call dirfiles(b)
[/pre]
 
Sorry Hui,


The call is not added in this code. I have tried to call several macros and I have also tried to paste in code between "next" and "end sub" but the next loop is interrupting anything that I try to do.


I just wanted to know if anyonw had experienced a similar problem with the next loop as I have.


I didn't add the call because I have tried several options to add the final step to this process.


Perhaps I should spend some time to add the comments as you suggested and post this again later


Thanks Hui


Lee
 
You must log in or register to reply here.
Back
Top