Last sheet does not follow the code

[ukanez]

Hi everyone, I have a workbook that has 12 worksheets for each province. I'm trying to select a row based on a value of a cell, cut that row, and insert it before another row lower in the worksheet.

I'm trying to do this for each worksheet in the workbook and have been having problems because the code executes with no errors, but the final sheet in the workbook remains unchanged. Thanks again for your help.

Application.ScreenUpdating = False
Dim rng1, cell, cella As Range
Dim ws As Worksheet

Workbooks("Provincial - INTERNAL" & ".xls").Activate

     Sheets(Array("BC", "AB", "SK", "MB", "Prairies", "ON", "QC", "NB", "PE", "NS", "NF", "Atlantic")).Copy
  
 For Each ws In ActiveWorkbook.Worksheets
     Set rngA = Range("C1", Range("C65536").End(xlUp))
         For Each cell In rngA
             If cell.Value = "A" Then
                 cell.EntireRow.Cut
             End If
         Next cell
         For Each cella In rngA
             If cella.Value = "B" Then
                 cella.EntireRow.Insert Shift:=xlDown
             End If
         Next
 With ws.UsedRange
     .Value = .Value
  
 End With
     Application.Goto ws.Cells(1, 1)
 Next

 

[ukanez]

Will there be any blank cells in col C other than the cut rows?
Also are all the cut rows being placed in the correct location?

Yes, the sheets have spaces within them so there are other blank cells in Col C. Also yes, the cut rows are all being placed in the correct location. The last sheet however has the "cut row" in both its original location and its intended location.

 

[Fluff]

Will you only have one cell with A & one with B per sheet, or could there be multiple instances per sheet?

 

[ukanez]

Will you only have one cell with A & one with B per sheet, or could there be multiple instances per sheet?

The former; there is only one cell "A" and one cell "B" in each sheet.

 

[Fluff]

Ok, how about

Application.ScreenUpdating = False
Dim i As Long
Dim ws As Worksheet

Workbooks("Provincial - INTERNAL" & ".xls").Activate

     Sheets(Array("BC", "AB", "SK", "MB", "Prairies", "ON", "QC", "NB", "PE", "NS", "NF", "Atlantic")).Copy
  
 For Each ws In ActiveWorkbook.Worksheets
   For i = ws.Range("C" & Rows.Count).End(xlUp).Row To 1 Step -1
      If ws.Range("C" & i).Value = "A" Then
         ws.Rows(i).Cut
         Set Rng = ws.Rows(i)
      ElseIf ws.Range("C" & i).Value = "B" Then
         ws.Rows(i).Insert xlDown
         Rng.Delete
         Exit For
      End If
   Next i
   Set Rng = Nothing
   With ws.UsedRange
       .Value = .Value
   End With
   Application.Goto ws.Cells(1, 1)
 Next ws

 

[ukanez]

Application.ScreenUpdating = False
Dim i As Long
Dim ws As Worksheet

Workbooks("Provincial - INTERNAL" & ".xls").Activate

     Sheets(Array("BC", "AB", "SK", "MB", "Prairies", "ON", "QC", "NB", "PE", "NS", "NF", "Atlantic")).Copy
  
 For Each ws In ActiveWorkbook.Worksheets
   For i = ws.Range("C" & Rows.Count).End(xlUp).Row To 1 Step -1
      If ws.Range("C" & i).Value = "A" Then
         ws.Rows(i).Cut
         Set Rng = ws.Rows(i)
      ElseIf ws.Range("C" & i).Value = "B" Then
         ws.Rows(i).Insert xlDown
[U]         Rng.Delete[/U]
         Exit For
      End If
   Next i
   Set Rng = Nothing
   With ws.UsedRange
       .Value = .Value
   End With
   Application.Goto ws.Cells(1, 1)
 Next ws

Seem to run into an Object Required error at the underlined rng.delete

 

[Fluff]

Is the cell containing "B" before the cell containing "A"?

 

[ukanez]

Is the cell containing "B" before the cell containing "A"?

The cell containing "A" is in row 34 and the cell containing "B" is in row 435.

 

[Fluff]

Ok, make this change

   For i = 1 To ws.Range("C" & Rows.Count).End(xlUp).Row

 

[ukanez]

Ok, make this change

   For i = 1 To ws.Range("C" & Rows.Count).End(xlUp).Row

The code runs without errors, but only cuts out row with cell "A" and does not insert that row before the row with cell "B"

edit: I should clarify and say that the row with cell "A" is gone from its original location and is nowhere else in the sheet.

 

[Fluff]

As you only have one A & one B, lets try a different tack.

Dim FndA As Range
Dim FndB As Range
Dim ws As Worksheet

Workbooks("Provincial - INTERNAL" & ".xls").Activate

     Sheets(Array("BC", "AB", "SK", "MB", "Prairies", "ON", "QC", "NB", "PE", "NS", "NF", "Atlantic")).Copy
  
 For Each ws In ActiveWorkbook.Worksheets
   Set FndA = ws.Range("C:C").Find("A", , , xlWhole, , , False, , False)
   Set FndB = ws.Range("C:C").Find("B", , , xlWhole, , , False, , False)
   FndA.EntireRow.Copy
   FndB.EntireRow.Insert
   FndA.EntireRow.Delete
   With ws.UsedRange
       .Value = .Value
   End With
   Application.Goto ws.Cells(1, 1)
 Next ws