Hi.
I have this specific code, and it just would not work by itself. I have to put a breakpoint at the point marked below for it to run perfectly. No error message or anything! It just doesn't complete certain parts in the coding, and doesn't finish the job unless I run it twice at different points(because of the breakpoint)! Please help!
I have this specific code, and it just would not work by itself. I have to put a breakpoint at the point marked below for it to run perfectly. No error message or anything! It just doesn't complete certain parts in the coding, and doesn't finish the job unless I run it twice at different points(because of the breakpoint)! Please help!
Code:
[COLOR=#333333]Sub Step1()[/COLOR]
Dim Counts As Long, Focus, m, CenterCo, CAL, p, q, i, n As LongDim Number, Width, Height, CenterC, CenterR, x As LongDim ET As LongApplication.ScreenUpdating = FalseET = InputBox("Which ET to execute? Ex) 7,8,9")Focus = InputBox("Which Focus to execute?")Sheets("Summary").Range("Q13:AS74").Delete Shift:=xlToLeftCells.SelectWith Selection.Font .Name = "Calibri" .Size = 11End With Selection.ColumnWidth = 8.43Sheets(3).SelectCells(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).SelectActiveSheet.Cells.SelectWith SelectionSelection.ColumnWidth = 13.57End WithIf Counts >= 13 Then Sheets(1).Select Sheets(1).Cells(109 + (Counts - 13), 1).SelectEnd IfIf Counts < 13 Then Sheets(1).Select Cells(109, 1).SelectEnd Ifp = 0q = 17While p < q ActiveCell.EntireRow.Insert p = p + 1WendIf Counts <= 13 Then Sheets("Summary").Rows("111:123").RowHeight = 75 Sheets("summary").Rows("110").RowHeight = 29.25End IfIf 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.25End If'Setting Up the Template'Sheets("Summary").SelectCells(15, 17).Selecti = 0n = (Counts - 13)While i < n i = i + 1 ActiveCell.EntireColumn.InsertWendi = 0Sheets("Summary").SelectCells(81, 16).SelectWhile i < n i = i + 1 ActiveCell.EntireRow.InsertWend'The New Columns and Rows are created'Sheets(3).Range("A6").EntireRow.CopySheets(3).Range("A5").PasteSpecialRange("A5").ClearOutline' This Copies all the CDs to Row 5'Worksheets(3).SelectActiveSheet.Rows("5:5").SelectSelection.SpecialCells(xlCellTypeBlanks).SelectSelection.Delete Shift:=xlToLeftRange(Cells(5, 1), Cells(5, Counts)).CopySheets("Summary").Range("B67").PasteSpecial Transpose:=TrueRange(Cells(5, 1), Cells(5, Counts)).CutSheets("Summary").SelectRange("C15").SelectActiveSheet.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=6][B][COLOR=#FF0000]BREAKPOINT[/COLOR][/B][/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 WithNextFor x = 0 To Counts * 2If 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 IfEnd IfNextx = 0While 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 + 1Wend' 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.PasteNext Sheets(3).Select Cells.SelectWith Selection .ColumnWidth = 13.57End Withm = 1 x = ActiveCell.Row y = ActiveCell.ColumnActiveSheet.Cells(7, 1).SelectWhile 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).SelectEnd 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 IfWend' ----------------------------------------------------------------------------------' Sheets(3).SelectActiveSheet.Cells(8, 1).Selectm = 1x = ActiveCell.Rowy = ActiveCell.ColumnWhile 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 IfWend ''''''''''''''''''' 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).ClearContentsSheets("Summary").SelectRange(Cells(15, 2), Cells(27, (Counts + 3))).SelectWith Selection.Borders .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomaticEnd WithRange(Cells(66, 2), Cells((67 + Counts), 15)).SelectWith Selection.Borders .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomaticEnd WithIf n > 0 Then Range(Cells(66, 2), Cells((67 + Counts), 15)).Select With Selection.Borders .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End WithEnd 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 WithWith Sheets(1) .Columns("R:R").HorizontalAlignment = xlCenter .Columns("R:R").VerticalAlignment = xlCenter .Columns("B:B").HorizontalAlignment = xlCenterEnd With'Sheets(3).Select'ActiveSheet.Cells.Select'With Selection'Selection.ColumnWidth = 13.57'End With'finished editing the format and template ' </pre>[COLOR=#333333]End Sub[/COLOR]
