Thread: Macro Loop Broken. Detects Max but doesn't continue loop

a friend kindly wrote a code for me that take data from one spreadsheet and lists it in set categories in another by fiscal years and quarters.

the code detects maxium of the 'FYs'-column in one sheet and then runs the loop from the minimum to the maxium.

the highest number in the FY-column is 2012, but the loop stops there even though there's data to copy to the other sheet, and that's where I need help. problem is that i need this asap

Here's the code:

Sub CopyRowstoDiffSheet()
'made by Wittig Rico
Dim ws1 As Worksheet, ws2 As Worksheet
Dim QUART As String, FYmax As String
Dim lngRow As Long, FY As Long, Leerzeile As Long, MaxZeile As Long, NeuZeile As Long, QuStZ As Long
Dim SuW1col As Long, SuW2col As Long, SuW3col As Long, SuW4col As Long, SuW5col As Long
Dim cathcol As Long, CrsNam As String, Crsvorh As Integer



Set ws1 = Sheets("Raw Data - Summary")
Set ws2 = Sheets("Scorecards")

ws2.Rows("3:65000").Borders(xlEdgeBottom).LineStyle = xlNone
ws2.Rows("3:65000").Borders(xlInsideHorizontal).LineStyle = xlNone
ws2.Range("A4:B65000").ClearContents
ws2.Range("C3:C65000").ClearContents
ws2.Range("I3:I65000").ClearContents
ws2.Range("O3:O65000").ClearContents
ws2.Range("U3:U65000").ClearContents
ws2.Range("AA3:AA65000").ClearContents


Application.ScreenUpdating = False


SuW1col = ws1.Range("A1:dd1").Find("Course Name").Column
SuW2col = ws1.Range("A1:dd1").Find("Region").Column
SuW3col = ws1.Range("A1:dd1").Find("FYs").Column
SuW4col = ws1.Range("A1:dd1").Find("Quarter").Column
SuW5col = ws1.Range("A1:dd1").Find("Course Category").Column



With ws1.Range(ws1.Cells(2, SuW3col), ws1.Cells(65000, SuW3col))
.Replace What:="FY", Replacement:=""
.NumberFormat = "0"
End With


If ws2.Range("b3").Value = "Q1" _
Or ws2.Range("b3").Value = "Q2" _
Or ws2.Range("b3").Value = "Q3" _
Or ws2.Range("b3").Value = "Q4" Then
GoTo weiter
Else
MsgBox ("Start-Quartal in zelle B3 eingeben")
GoTo Ende
End If

weiter:


If ws2.Range("a3").Value = Empty _
Or ws2.Range("a3").Value < 2000 Then
MsgBox ("Start-Jahr in zelle A3 eingeben")
GoTo Ende
End If


If Not IsNumeric(ws2.Range("a3").Value) Then
MsgBox ("Start-Jahr in zelle A3 eingeben")
End If


FY = ws2.Range("a3").Value
FYmax = WorksheetFunction.Max(ws1.Range(ws1.Cells(2, SuW3col), ws1.Cells(65000, SuW3col)))


If FY > FYmax Then
MsgBox ("ab diesem Start-Jahr keine Ergebnisse vorhanden")
GoTo Ende
End If

MaxZeile = 3
QuStZ = MaxZeile
QUART = ws2.Range("b" & MaxZeile).Value
FY = ws2.Range("a" & MaxZeile).Value

Do Until FY = FYmax

Do Until QUART = "Q5"
For lngRow = 1 To ws1.Cells(Rows.Count, SuW5col).End(xlUp).Row Step 1

If ws1.Cells(lngRow, SuW2col) = ws2.Range("A1") _
And ws1.Cells(lngRow, SuW3col) = ws2.Range("a" & MaxZeile) _
And ws1.Cells(lngRow, SuW4col) = ws2.Range("b" & MaxZeile) Then

CrsNam = ws1.Cells(lngRow, SuW1col).Value
cathcol = ws2.Range("A1:dd2").Find(ws1.Cells(lngRow, SuW5col).Value).Column
Leerzeile = ws2.Cells(Rows.Count, ws2.Range("A1:dd2"). _
Find(ws1.Cells(lngRow, SuW5col).Value).Column).End(xlUp).Row + 1

Crsvorh = Application.WorksheetFunction.CountIf(ws2.Range(Cells(QuStZ, cathcol), Cells(Leerzeile, cathcol)) _
, Trim(CrsNam))

If Crsvorh > 0 Then
GoTo wertexist
Else
End If


If NeuZeile > Leerzeile Then
Leerzeile = NeuZeile
End If

If Leerzeile > MaxZeile Then
MaxZeile = Leerzeile
ws2.Range("a" & MaxZeile).Value = ws2.Range("a" & MaxZeile - 1).Value
ws2.Range("b" & MaxZeile).Value = ws2.Range("b" & MaxZeile - 1).Value
End If

ws2.Cells(Leerzeile, ws2.Range("A1:dd2").Find(ws1.Cells(lngRow, SuW5col).Value).Column).Value _
= CrsNam

Else
End If

wertexist:
Next

ws2.Range("A" & MaxZeile & ":AF" & MaxZeile).Borders(xlEdgeBottom).Weight = xlThick

If QUART = "Q4" Then QUART = "Q5"
If QUART = "Q3" Then QUART = "Q4"
If QUART = "Q2" Then QUART = "Q3"
If QUART = "Q1" Then QUART = "Q2"

MaxZeile = MaxZeile + 1
NeuZeile = MaxZeile
QuStZ = MaxZeile

If MaxZeile > 3 Then
ws2.Range("a" & MaxZeile).Value = ws2.Range("a" & MaxZeile - 1).Value
Else
End If

ws2.Range("b" & MaxZeile).Value = QUART

Loop
FY = FY + 1
ws2.Range("a" & MaxZeile).Value = FY
QUART = "Q1"
ws2.Range("b" & MaxZeile).Value = QUART
ws2.Range("A" & MaxZeile - 1 & ":AG" & MaxZeile - 1).Borders(xlEdgeBottom).LineStyle = xlDouble
Loop

Ende:
Application.ScreenUpdating = True
End Sub

i just fixed it yay!

i think the loop stopped because the maximum was 2012 so it stopped because it said do until it's gotten to the maximum.

so I added a +1 to that yaaay