leal72
08-26-2014, 09:01 AM
I have this code to find then minimum value in column "C", look through all the cells in "C" with values, if the value matches the minimum I want it to move the row from column "A:D".
In the workbook example you will notice that it works correct on row 1 and 3 but skips row 2.
Sub Macro()
Dim fName As String
Dim lastRow As Long
Dim endRow As Long
Dim cRow As Long
Dim zIndex As Long
Dim zLayer As String
Dim zMin As Double
Dim zCell As Range
fName = ActiveSheet.Name
lastRow = Sheets(fName).Range("AZ1").End(xlDown).Row
endRow = Sheets(fName).Range("C" & lastRow).End(xlUp).Row
For zIndex = 1 To endRow
zLayer = "Layer_" & zIndex
zMin = Application.WorksheetFunction.Min(Sheets(fName).Range("C1:C" & endRow))
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = zLayer
cRow = 1
For Each zCell In Sheets(fName).Range("C1:C" & endRow)
If zCell.Value = zMin Then
Sheets(fName).Range(zCell.Offset(0, -2), zCell.Offset(0, 1)).Cut _
Sheets(zLayer).Range("A" & cRow)
cRow = cRow + 1
End If
Next zCell
Next
End Sub
In the workbook example you will notice that it works correct on row 1 and 3 but skips row 2.
Sub Macro()
Dim fName As String
Dim lastRow As Long
Dim endRow As Long
Dim cRow As Long
Dim zIndex As Long
Dim zLayer As String
Dim zMin As Double
Dim zCell As Range
fName = ActiveSheet.Name
lastRow = Sheets(fName).Range("AZ1").End(xlDown).Row
endRow = Sheets(fName).Range("C" & lastRow).End(xlUp).Row
For zIndex = 1 To endRow
zLayer = "Layer_" & zIndex
zMin = Application.WorksheetFunction.Min(Sheets(fName).Range("C1:C" & endRow))
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = zLayer
cRow = 1
For Each zCell In Sheets(fName).Range("C1:C" & endRow)
If zCell.Value = zMin Then
Sheets(fName).Range(zCell.Offset(0, -2), zCell.Offset(0, 1)).Cut _
Sheets(zLayer).Range("A" & cRow)
cRow = cRow + 1
End If
Next zCell
Next
End Sub