No Error Msg. Without breakpoint, code does not fully work!!

D

dhs911230

New Member
Joined
Jun 12, 2014
Messages
20
Hi.


Below is my coding, and If I put a breakpoint at the point indicated below, the entire macro works fine. However, if I get rid of the breakpoint and run the entire code at once, the macro skips several steps (some while loops don't even run at all). And I just cannot seem to find the problem! Please help...Thank you so much.






Code: 
Sub Step1()
Dim Counts As Long, Focus, m, CenterCo, CAL, p, q, i, n As Long
Dim Number, Width, Height, CenterC, CenterR, x As Long
Dim ET As Long
Application.ScreenUpdating = False
ET = InputBox("Which ET to execute? Ex) 7,8,9")
Focus = InputBox("Which Focus to execute?")
Sheets("Summary").Range("Q13:AS74").Delete Shift:=xlToLeft
Cells.Select
With Selection.Font
    .Name = "Calibri"
    .Size = 11
End With
    Selection.ColumnWidth = 8.43
Sheets(3).Select
Cells(1, 5).Value = "=COUNTA(6:6)"
Counts = Cells(1, 5).Value
' Counts is now the number of CD's in the Excel File '
Sheets(3).Select
ActiveSheet.Cells.Select
With Selection
Selection.ColumnWidth = 13.57
End With
If Counts >= 13 Then
    Sheets(1).Select
    Sheets(1).Cells(109 + (Counts - 13), 1).Select
End If
If Counts < 13 Then
    Sheets(1).Select
    Cells(109, 1).Select
End If
p = 0
q = 17
While p < q
    ActiveCell.EntireRow.Insert
    p = p + 1
Wend
If Counts <= 13 Then
        Sheets("Summary").Rows("111:123").RowHeight = 75
      Sheets("summary").Rows("110").RowHeight = 29.25
End If
If Counts > 13 Then
    Sheets("Summary").Rows((111 + Counts - 13) & ":" & (123 + Counts - 13)).RowHeight = 75
    Sheets("summary").Rows((110 + Counts - 13) & ":" & (110 + Counts - 13)).RowHeight = 29.25
End If
'Setting Up the Template'
Sheets("Summary").Select
Cells(15, 17).Select
i = 0
n = (Counts - 13)
While i < n
    i = i + 1
    ActiveCell.EntireColumn.Insert
Wend
i = 0
Sheets("Summary").Select
Cells(81, 16).Select
While i < n
    i = i + 1
    ActiveCell.EntireRow.Insert
Wend
'The New Columns and Rows are created'
Sheets(3).Range("A6").EntireRow.Copy
Sheets(3).Range("A5").PasteSpecial
Range("A5").ClearOutline
' This Copies all the CDs to Row 5'
Worksheets(3).Select
ActiveSheet.Rows("5:5").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlToLeft
Range(Cells(5, 1), Cells(5, Counts)).Copy
Sheets("Summary").Range("B67").PasteSpecial Transpose:=True
Range(Cells(5, 1), Cells(5, Counts)).Cut
Sheets("Summary").Select
Range("C15").Select
ActiveSheet.Paste
' Finished Copy-Pasting CD's to Summary Page Table'
'---------------------------------'

    Sheets(3).Select
    Cells(7, 2).Select
    Number = 1
    While Number > 0
            Selection.Offset(0, 1).Select
            Number = Selection.Value
    Wend
    If Number = 0 Then
            Selection.Offset(0, -1).Select
            y = ActiveCell.Column
    End If
   Width = y - 1
    CenterC = ((Width - 1) / 2) + 2
' We have determined the Center Column Coordinate for the Measurements '
    Sheets(3).Cells(8, 1).Select
    Number = 1
    While Number > 0
            Selection.Offset(1, 0).Select
    Number = Selection.Value
        If Number = 0 Then
            Selection.Offset(-1, 0).Select
            x = ActiveCell.Row
       End If
    Wend
    Height = x - 7
    CenterR = ((Height - 1) / 2) + 8
    
' Start Setting Up The Image Template '
 

[SIZE=5][COLOR=#FF0000][B]BREAKPOINT[/B][/COLOR][/SIZE]

For x = 0 To Counts - 1
    If CStr(Counts) > 13 Then
        Cells(110 + Counts, 19 + x * 2).Value = "CD" & x + 1 & ""
        Cells(110 + Counts, 19 + x * 2).Select
    End If
    If CStr(Counts) <= 13 Then
        Cells(110, 19 + x * 2).Value = "CD" & x + 1 & ""
        Cells(110, 19 + x * 2).Select
    End If
    ActiveCell.Select
    With Selection.Font
        .Size = 22
        .Bold = True
    End With
Next
For x = 0 To Counts * 2
If IsEmpty(Cells(110, 19 + x)) = True Then
    If Counts > 13 Then
        Cells(110 + (Counts - 13), 19 + x).ColumnWidth = 1.75
        Cells(110 + (Counts - 13), 19 + x - 1).ColumnWidth = 13.57
    End If
    If Counts <= 13 Then
        Cells(110 + (Counts - 13), 19 + x).ColumnWidth = 1.75
        Cells(110, 19 + x - 1).ColumnWidth = 13.57
    End If
End If
Next
x = 0

While x < 12
    If CStr(Counts) > 13 Then
        Cells(111 + Counts + x, 18).Value = "=B" & 16 + x & ""
        Cells(111 + Counts + x, 18).Select
    End If
    If CStr(Counts) <= 13 Then
        Cells(111 + x, 18).Value = "=B" & 16 + x & ""
        Cells(111 + x, 18).Select
    End If
    With Selection.Borders
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Font
        .Color = vbBlue
        .Bold = True
    End With
    x = x + 1
Wend
' Finished editing the template.
' Center Cell of Measurements is (CenterR, CenterC) while the dimentions are'
' Width and Height'
 'Will Start copy-pasting Pictures'
For x = 1 To Counts
    Sheets(3).Select
    ActiveSheet.Range(Cells(21, (1 + CenterCo + (Width + 2) * (x - 1))), _
    Cells((21 + Height), (1 + CenterCo + (Width + 2) * (x - 1)))).Select
    Selection.Copy
    Sheets("Summary").Select
    Cells(111, 19 + ((x - 1) * 2)).Select
    ActiveSheet.Paste
Next
    
Sheets(3).Select
    Cells.Select
With Selection
    .ColumnWidth = 13.57
End With
m = 1
    x = ActiveCell.Row
    y = ActiveCell.Column
ActiveSheet.Cells(7, 1).Select
While m <= Counts And y <= (Counts + 1) * (2 + Width)
If Selection.Value = ET Then
    Selection.Offset(1, 0).Select
    x = ActiveCell.Row
    y = ActiveCell.Column
    Sheets(3).Range(Cells(8, y), Cells((7 + Height), y)).Copy
    Sheets("summary").Select
    Cells(17, 2 + m).Select
    ActiveSheet.Paste
    'copy-pasting measurements'
    Sheets(3).Select
    ActiveSheet.Range(Cells(21, y), Cells((20 + Height), y)).Copy
    Sheets("Summary").Select
    If Counts <= 13 Then
        Cells(112, 19 + ((m - 1) * 2)).Select
        ActiveSheet.Paste
    End If
    If Counts > 13 Then
        Sheets("Summary").Select
        Cells(111 + Counts - 13, 19 + ((m - 1) * 2)).Select
        ActiveSheet.Paste
    End If
    'Copy-pasting Pics'
    m = m + 1
    Sheets(3).Select
    ActiveSheet.Cells(x, y).Select
    Selection.Offset(-1, 1).Select
End If
    If Selection.Value <> ET Then
            x = ActiveCell.Row
            y = ActiveCell.Column
            y = y + 1
            Sheets(3).Select
            Sheets(3).Cells(x, y).Select
           Else
               m = m
     End If
Wend
' ----------------------------------------------------------------------------------'
 
    
Sheets(3).Select
ActiveSheet.Cells(8, 1).Select
m = 1
x = ActiveCell.Row
y = ActiveCell.Column
While m <= Counts And x <= (Counts + 1) * (2 + Width)
    If CStr(Selection.Value) = Focus Then
        x = ActiveCell.Row
        y = ActiveCell.Column
 '      MsgBox "y equals " & y & vbCrLf & "Selection.Value equals " & Selection.Value & vbCrLf & "focus equals " & Focus
        Sheets(3).Range(Cells(x, y), Cells(x, y + Width)).Copy
        Sheets(1).Select
        CAL = (9 - (Width + 1) / 2)
        Cells(66 + m, CAL).Select
        ActiveSheet.Paste
        m = m + 1
        Sheets(3).Select
        ActiveSheet.Cells(8, 1 + (Width + 2) * m).Select
    End If
    If Selection.Value <> Focus Then
            x = ActiveCell.Row
            y = ActiveCell.Column
            x = x + 1
            Sheets(3).Select
            Sheets(3).Cells(x, y).Select
  '      Selection.Offset(1, 0).Select
    End If
Wend
    
''''''''''''''''''' This part copies the horizontal values'''''''''''''
    For i = 17 To 25
        For j = 3 To 14
            Cells(i, j).Select
           If IsNumeric(Selection.Value) = False Then
                ActiveCell.Interior.Color = vbBlack
                ActiveCell.ClearContents
           End If
        Next
    Next
'Successfully Finished Formatting the Table'
  
    
ActiveSheet.Cells(1, 5).ClearContents
Sheets("Summary").Select
Range(Cells(15, 2), Cells(27, (Counts + 3))).Select
With Selection.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
End With
Range(Cells(66, 2), Cells((67 + Counts), 15)).Select
With Selection.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
End With
If n > 0 Then
    Range(Cells(66, 2), Cells((67 + Counts), 15)).Select
    With Selection.Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End If
' Finished Adding Table'
Sheets("Summary").Pictures.Select
    Selection.ShapeRange.Width = 75
    Selection.ShapeRange.Height = 75
'Resizing the Photos'
'Adding the Arrow to Pictures'
Sheets(1).Shapes.AddShape(msoShapeRightArrow, 800, 2040, 800, 75).Select
' column location, row location, length, thickness'
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 255, 0)
        .Transparency = 0.5
        .Solid
    End With
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
With Sheets(1)
        .Columns("R:R").HorizontalAlignment = xlCenter
        .Columns("R:R").VerticalAlignment = xlCenter
        .Columns("B:B").HorizontalAlignment = xlCenter
End With
'Sheets(3).Select
'ActiveSheet.Cells.Select
'With Selection
'Selection.ColumnWidth = 13.57
'End With
'finished editing the format and template '
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

C
  • Question
Colouring cells based on contains value
Replies
2
Views
141
CawstonT
C
S
  • Solved
Compare cell in column to cells below
2
Replies
13
Views
603
kevin9999
K
M
  • Solved
Getting Loop without Do error
Replies
2
Views
215
mdd16
M
L
  • Question
Help with VBA code for a userform
Replies
1
Views
252
dmt32
D
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
399
AndyEd
A

Forum statistics

Threads
1,214,991
Messages
6,122,628
Members
449,095
Latest member
bsb1122

Share this page

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