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

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,214,606
Messages
6,120,485
Members
448,967
Latest member
visheshkotha

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
Back
Top