I can't get this to loop through to the next row. The inner two loops are working fine from what i can tell using the debugger but it never goes to the next row. Any help would be appreciated.
Sub PopulateData()
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim locationRow As Integer
Set s1 = ThisWorkbook.Sheets("Order_LVL")
Set s2 = ThisWorkbook.Sheets("sheet1")
Dim Lastrow As Integer
Lastrow = s1.Cells(Rows.Count, 1).End(xlUp).Row
Dim iRow As Integer
For iRow = 1 To Lastrow
Dim cellj As Range
For Each cellj In s1.Range("B:F")
locationRow = 1
Dim celli As Range
For Each celli In s2.Range("B1:F1")
Dim currentrow As Long
currentrow = iRow + 1
If s1.Cells(currentrow, cellj.Column).Value = 0 Then
ElseIf s1.Cells(currentrow, cellj.Column).Value <> s2.Cells(locationRow, celli.Column).Value And s2.Cells(currentrow, celli.Column).Value = 0 Then
s2.Cells(currentrow, celli.Column).Value = 0
Else: s2.Cells(currentrow, celli.Column).Value = 1 'indicates that this order features a line from this location
End If
Next celli
Next cellj
Next iRow
End Sub
Can you try this on some test data (Note I haven't tested it myself but re-written it with only two loops)
Sub PopulateData()
Dim s1 As Worksheet: Dim s2 As Worksheet
Dim rng As range: Dim rng2 As range
Dim cell: Dim header
With Application
.ScreenUpdating = False
End With
With ThisWorkbook
Set s1 = .Sheets("Order_LVL")
Set s2 = .Sheets("sheet1")
End With
With s1
Set rng = range(.Cells(1, 2), .Cells(.Cells(Rows.Count, 6).End(xlUp).Row, 6)) ' Used Range in Order_LVL
End With
Set rng2 = range(s2.Cells(1, 2), s2.Cells(1, 6)) 'Header range in sheet1
For Each cell In rng.Cells
For Each header In rng2.Cells
If cell.value = 0 Then
ElseIf cell.value <> header.value And s2.Cells(cell.Row, header.Column).value = 0 Then
s2.Cells(cell.Row, header.Column).value = 0 ' Not sure why you're doing this - if it is already 0 why set it back to 0. Left it in for continuity
Else
s2.Cells(cell.Row, header.Column).value = 1 ' indicates that this order features a line from this location
End If
Next header
Next cell
With Application
.ScreenUpdating = True
End With
End Sub
It should do what you want if I've understood correctly.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.