Help Cleaning up and DeBugging Macro

Smoo

New Member
Joined
Sep 15, 2006
Messages
9
Hi,

I've created the following macro using the "Record Macro" Feature and bits of other macro's. I'm looking to have the macro pull duplicate data from multiple worksheets and place that data in the "Summary" worksheet. I also need the macro to format the columns and rows. When I go to run the macro I get this error message "Object Variable or With Block Variable not set". I'm so confused. Any help would be wonderful!
Code:
Sub Summary444()
    Dim wsh As Worksheet
    Dim wshOpen As Worksheet
    Dim r As Long
    Dim n As Long
    Dim t As Long

    Application.ScreenUpdating = False
    Set wshOpen = Worksheets("Summary")
    wshOpen.Range("A2:D65536").ClearContents
    t = 1
  With Application
      For i = 1 To .ActiveWorkbook.Worksheets.Count
         If .Sheets(i).Name <> SUMMARY_SHEET_NAME Then
            .Sheets(i).Select
            .Range("A3").Select
            j = 0
            Do Until IsEmpty(.ActiveCell.Offset(j, 0).Value)
               sName = VBA.Trim(.ActiveCell.Offset(j, 0).Value)
               sDateOfInfraction = .ActiveCell.Offset(j, 1).Value
               j = j + 1
              Loop
          End If
     Next i
           wsh.Range("A" & r & ":D" & r).Copy _
         Destination:=wshOpen.Range("A" & t)
  Columns("A:D").Select
    Selection.ColumnWidth = 21.57
    Rows("1:50").Select
    Selection.RowHeight = 20
    ActiveWindow.SmallScroll Down:=-30
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Name"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Date"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Time"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Reason"
    Rows("1:1").Select
    Selection.Font.Bold = True
    Range("A1:D1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    Range("A2:D50").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    ActiveWindow.SmallScroll Down:=-15
    Range("B2:C50").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        
ExitHandler:
    Set wsh = Nothing
    Set wshOpen = Nothing
    Application.ScreenUpdating = True
    Exit Sub
        End With
       
     End With

End Sub

Thank you,

SMOO

EDIT: The Bold tags won't work within the Code tags - Smitty
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

lozzablake

Well-known Member
Joined
Dec 15, 2005
Messages
818
your End Withs are in the wrong place. They must be above ExitHandler

Also generally speaking you do not need to 'Select' or 'Activate' cells. You can just address the cells directly eg instead of:

Code:
Columns("A:D").Select 
Selection.ColumnWidth = 21.57

use:

Code:
Columns("A:D").ColumnWidth = 21.57
 

Smoo

New Member
Joined
Sep 15, 2006
Messages
9
Thank you for the helpful hints. I will keep that in mind next time I try my hand at macro's. Again, Thank you for your help.

SMOO
 

Forum statistics

Threads
1,141,097
Messages
5,704,313
Members
421,338
Latest member
Pepess

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top