PDA

View Full Version : VBA code skipping cells, not sure why?



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

ranman256
08-26-2014, 10:36 AM
probably you are going from 1 to endRow in rows. But if you remove a row , you messed up your counter.
Go from endRow to 1 step -1

Bob Phillips
08-26-2014, 12:00 PM
Sub Macro()
Dim sh As Worksheet, sh2 As Worksheet
Dim zRng As Range
Dim lastRow As Long
Dim zLayer As Long
Dim zMin As Double

Application.ScreenUpdating = False

Set sh = ActiveSheet
With sh

zLayer = 1

Do While Application.CountA(.Columns("C")) > 1

lastRow = .Range("C" & .Rows.Count).End(xlUp).Row

zMin = Application.Min(.Columns("C"))
If zMin <> 0 Then

.Rows(1).Insert
.Range("C1").Value = "tmp"

.Columns("A:D").AutoFilter Field:=3, Criteria1:=zMin
Set zRng = .Range("A1").Resize(lastRow, 4).SpecialCells(xlCellTypeVisible)

Set sh2 = Nothing
On Error Resume Next
Set sh2 = Worksheets("Layer_" & zLayer)
On Error GoTo 0
If sh2 Is Nothing Then

Set sh2 = Worksheets.Add(After:=Worksheets(Worksheets.Count))
sh2.Name = "Layer_" & zLayer
Else

sh2.UsedRange.ClearContents
End If

zRng.Copy sh2.Range("A1")
zRng.EntireRow.Delete

sh2.Rows(1).Delete

zLayer = zLayer + 1
End If
Loop
End With

Application.ScreenUpdating = True
End Sub

leal72
08-26-2014, 12:04 PM
probably you are going from 1 to endRow in rows. But if you remove a row , you messed up your counter.
Go from endRow to 1 step -1

Thanks for looking but that did not work either, same result. Not processing the second row.

leal72
08-26-2014, 12:16 PM
Sub Macro()
Dim sh As Worksheet, sh2 As Worksheet
Dim zRng As Range
Dim lastRow As Long
Dim zLayer As Long
Dim zMin As Double

Application.ScreenUpdating = False

Set sh = ActiveSheet
With sh

zLayer = 1

Do While Application.CountA(.Columns("C")) > 1

lastRow = .Range("C" & .Rows.Count).End(xlUp).Row

zMin = Application.Min(.Columns("C"))
If zMin <> 0 Then

.Rows(1).Insert
.Range("C1").Value = "tmp"

.Columns("A:D").AutoFilter Field:=3, Criteria1:=zMin
Set zRng = .Range("A1").Resize(lastRow, 4).SpecialCells(xlCellTypeVisible)

Set sh2 = Nothing
On Error Resume Next
Set sh2 = Worksheets("Layer_" & zLayer)
On Error GoTo 0
If sh2 Is Nothing Then

Set sh2 = Worksheets.Add(After:=Worksheets(Worksheets.Count))
sh2.Name = "Layer_" & zLayer
Else

sh2.UsedRange.ClearContents
End If

zRng.Copy sh2.Range("A1")
zRng.EntireRow.Delete

sh2.Rows(1).Delete

zLayer = zLayer + 1
End If
Loop
End With

Application.ScreenUpdating = True
End Sub


This works!:thumb

I do appreciate the help.

The individual sheets all look correct, the main worksheet still has a single row with values in it.

I'm going to try and go through this one to see what each line is doing.

Thank you!