ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VB help (https://www.excelbanter.com/excel-programming/317031-vbulletin-help.html)

Josh Webb

VB help
 
My VB coding is not very good....
This code keep erroring out at the first "End If." Any
idea why?
TFTH,
Josh



' Delete the empty rows on "Active Container"

Dim rw As Long, iCol As Integer
For rw = Sheets("Active
Container").UsedRange.Rows.Count To 1 Step -1
If IsEmpty(Cells(rw, 1)) Then
If Cells(rw, Columns.Count).End(xlToLeft).Column
= 1 Then
Rows(rw).Delete
End If
End If
Next
End Sub

Bob Phillips[_6_]

VB help
 
Put a line

MsgBox rw

before that line. If you get 0 your range is the problem.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Josh Webb" wrote in message
...
My VB coding is not very good....
This code keep erroring out at the first "End If." Any
idea why?
TFTH,
Josh



' Delete the empty rows on "Active Container"

Dim rw As Long, iCol As Integer
For rw = Sheets("Active
Container").UsedRange.Rows.Count To 1 Step -1
If IsEmpty(Cells(rw, 1)) Then
If Cells(rw, Columns.Count).End(xlToLeft).Column
= 1 Then
Rows(rw).Delete
End If
End If
Next
End Sub




Josh Webb

VB help
 
Bob,
Thanks for the assistance, but it returned 1877 in the
msgbox. I have attached the full VB so you can view where
I maybe lacking.

TFTH again,
Josh

Dim iLastRow As Integer
Dim dLastRow As Integer
Dim i As Integer

If Application.WorksheetFunction.Sum(Sheets("Active
Container").Range("A:A")) = 0 Then
MsgBox "You haven't placed a 1 next to any rows!"
Exit Sub
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Active Container").Activate
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row

' Cut and move rows with 1 in Col. A to "Recent History"

For i = iLastRow To 4 Step -1

dLastRow = Sheets("Recent History").Cells
(Rows.Count, "A").End(xlUp).Row

With Sheets("Active Container").Cells(i, 1)
If .Value = 1 Then
.EntireRow.Cut Sheets("Recent History").Cells
(dLastRow + 1, 1)
End If
End With
Next i

' Delete the empty rows on "Active Container"

Dim rw As Long, iCol As Integer
For rw = Sheets("Active
Container").UsedRange.Rows.Count To 1 Step -1
If IsEmpty(Cells(rw, 1)) Then
If Cells(rw, Columns.Count).End(xlToLeft).Column
= 1 Then
Rows(rw).Delete
End If
End If
Next
End Sub
-----Original Message-----
Put a line

MsgBox rw

before that line. If you get 0 your range is the problem.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Josh Webb" wrote

in message
...
My VB coding is not very good....
This code keep erroring out at the first "End If." Any
idea why?
TFTH,
Josh



' Delete the empty rows on "Active Container"

Dim rw As Long, iCol As Integer
For rw = Sheets("Active
Container").UsedRange.Rows.Count To 1 Step -1
If IsEmpty(Cells(rw, 1)) Then
If Cells(rw, Columns.Count).End

(xlToLeft).Column
= 1 Then
Rows(rw).Delete
End If
End If
Next
End Sub



.


Bob Phillips[_6_]

VB help
 
Josh,

I tried it and it worked okay for me with a few small mods to make sure all
objects were properly qualified

Dim iLastRow As Integer
Dim dLastRow As Integer
Dim i As Integer

If Application.WorksheetFunction.Sum(Sheets("Active
Container").Range("A:A")) = 0 Then
MsgBox "You haven't placed a 1 next to any rows!"
Exit Sub
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Active Container").Activate
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row

' Cut and move rows with 1 in Col. A to "Recent History"

For i = iLastRow To 4 Step -1

dLastRow = Sheets("Recent History").Cells(Rows.Count,
"A").End(xlUp).Row

With Sheets("Active Container").Cells(i, 1)
If .Value = 1 Then
.EntireRow.Cut Sheets("Recent History").Cells(dLastRow + 1,
1)
End If
End With
Next i

' Delete the empty rows on "Active Container"

With Sheets("Active Container")
Dim rw As Long, iCol As Integer
For rw = .UsedRange.Rows.Count To 1 Step -1
If IsEmpty(.Cells(rw, 1)) Then
If .Cells(rw, Columns.Count).End(xlToLeft).Column = 1 Then
.Rows(rw).Delete
End If
End If
Next
End With


--

HTH

RP
(remove nothere from the email address if mailing direct)


"Josh Webb" wrote in message
...
Bob,
Thanks for the assistance, but it returned 1877 in the
msgbox. I have attached the full VB so you can view where
I maybe lacking.

TFTH again,
Josh

Dim iLastRow As Integer
Dim dLastRow As Integer
Dim i As Integer

If Application.WorksheetFunction.Sum(Sheets("Active
Container").Range("A:A")) = 0 Then
MsgBox "You haven't placed a 1 next to any rows!"
Exit Sub
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("Active Container").Activate
iLastRow = Cells(Rows.Count, "A").End(xlUp).Row

' Cut and move rows with 1 in Col. A to "Recent History"

For i = iLastRow To 4 Step -1

dLastRow = Sheets("Recent History").Cells
(Rows.Count, "A").End(xlUp).Row

With Sheets("Active Container").Cells(i, 1)
If .Value = 1 Then
.EntireRow.Cut Sheets("Recent History").Cells
(dLastRow + 1, 1)
End If
End With
Next i

' Delete the empty rows on "Active Container"

Dim rw As Long, iCol As Integer
For rw = Sheets("Active
Container").UsedRange.Rows.Count To 1 Step -1
If IsEmpty(Cells(rw, 1)) Then
If Cells(rw, Columns.Count).End(xlToLeft).Column
= 1 Then
Rows(rw).Delete
End If
End If
Next
End Sub
-----Original Message-----
Put a line

MsgBox rw

before that line. If you get 0 your range is the problem.

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Josh Webb" wrote

in message
...
My VB coding is not very good....
This code keep erroring out at the first "End If." Any
idea why?
TFTH,
Josh



' Delete the empty rows on "Active Container"

Dim rw As Long, iCol As Integer
For rw = Sheets("Active
Container").UsedRange.Rows.Count To 1 Step -1
If IsEmpty(Cells(rw, 1)) Then
If Cells(rw, Columns.Count).End

(xlToLeft).Column
= 1 Then
Rows(rw).Delete
End If
End If
Next
End Sub



.





All times are GMT +1. The time now is 12:32 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com