Need help to tidy up Code

A

aespinoza

New Member
Joined
Mar 1, 2017
Messages
11
Hi

I have the Following Code that repeats its self every 30 rows.
is there a way for make the "IF" do this until the sheet no longer as filled in rows as the procedure is too large to run at the mo.
I realise i can split it up into different subs, but i would like it to all run together.

Thanks in advance

I am only showing a sample of the code as it is juts repeated adding 30 rows a time.

If Sheets("On Market").Range("B26") < Date - 4 Then

Sheets("On Market").Select
ActiveWindow.SmallScroll Down:=12
Range("B26:P28").Select
Application.CutCopyMode = False
Selection.Copy
Range("B27:C27").Select
ActiveSheet.Paste
Range("B28:C29").Select
Application.CutCopyMode = False
Selection.Merge True
Range("D28:P29").Select
Selection.Merge True
Range("B26:P26").Select
Selection.ClearContents
Range("B27:P27").Select
Selection.Font.Bold = False
Selection.Font.Italic = True
Range("B26:P29").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With

End If

If Sheets("On Market").Range("B56") < Date - 4 Then
Sheets("On Market").Select
ActiveWindow.SmallScroll Down:=12
Range("B56:P58").Select
Application.CutCopyMode = False
Selection.Copy
Range("B57:C57").Select
ActiveSheet.Paste
Range("B58:C59").Select
Application.CutCopyMode = False
Selection.Merge True
Range("D58:P59").Select
Selection.Merge True
Range("B56:P56").Select
Selection.ClearContents
Range("B57:P57").Select
Selection.Font.Bold = False
Selection.Font.Italic = True
Range("B56:P59").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If

If Sheets("On Market").Range("B86") < Date - 4 Then
Sheets("On Market").Select
ActiveWindow.SmallScroll Down:=12
Range("B86:P88").Select
Application.CutCopyMode = False
Selection.Copy
Range("B87:C87").Select
ActiveSheet.Paste
Range("B88:C89").Select
Application.CutCopyMode = False
Selection.Merge True
Range("D88:P89").Select
Selection.Merge True
Range("B86:P86").Select
Selection.ClearContents
Range("B87:P87").Select
Selection.Font.Bold = False
Selection.Font.Italic = True
Range("B86:P89").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If

If Sheets("On Market").Range("B116") < Date - 4 Then
Sheets("On Market").Select
ActiveWindow.SmallScroll Down:=12
Range("B116:P118").Select
Application.CutCopyMode = False
Selection.Copy
Range("B117:C117").Select
ActiveSheet.Paste
Range("B118:C119").Select
Application.CutCopyMode = False
Selection.Merge True
Range("D118:P119").Select
Selection.Merge True
Range("B116:P116").Select
Selection.ClearContents
Range("B117:P117").Select
Selection.Font.Bold = False
Selection.Font.Italic = True
Range("B116:P119").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If

If Sheets("On Market").Range("B146") < Date - 4 Then
Sheets("On Market").Select
ActiveWindow.SmallScroll Down:=12
Range("B146:P148").Select
Application.CutCopyMode = False
Selection.Copy
Range("B147:C147").Select
ActiveSheet.Paste
Range("B148:C149").Select
Application.CutCopyMode = False
Selection.Merge True
Range("D148:P149").Select
Selection.Merge True
Range("B146:P146").Select
Selection.ClearContents
Range("B147:P147").Select
Selection.Font.Bold = False
Selection.Font.Italic = True
Range("B146:P149").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If

If Sheets("On Market").Range("B176") < Date - 4 Then
Sheets("On Market").Select
ActiveWindow.SmallScroll Down:=12
Range("B176:P178").Select
Application.CutCopyMode = False
Selection.Copy
Range("B177:C177").Select
ActiveSheet.Paste
Range("B178:C179").Select
Application.CutCopyMode = False
Selection.Merge True
Range("D178:P179").Select
Selection.Merge True
Range("B176:P176").Select
Selection.ClearContents
Range("B177:P177").Select
Selection.Font.Bold = False
Selection.Font.Italic = True
Range("B176:P179").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If

If Sheets("On Market").Range("B206") < Date - 4 Then
Sheets("On Market").Select
ActiveWindow.SmallScroll Down:=12
Range("B206:P208").Select
Application.CutCopyMode = False
Selection.Copy
Range("B207:C207").Select
ActiveSheet.Paste
Range("B208:C209").Select
Application.CutCopyMode = False
Selection.Merge True
Range("D208:P209").Select
Selection.Merge True
Range("B206:P206").Select
Selection.ClearContents
Range("B207:P207").Select
Selection.Font.Bold = False
Selection.Font.Italic = True
Range("B206:P209").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If


If Sheets("On Market").Range("B236") < Date - 4 Then
Sheets("On Market").Select
ActiveWindow.SmallScroll Down:=12
Range("B236:P238").Select
Application.CutCopyMode = False
Selection.Copy
Range("B237:C237").Select
ActiveSheet.Paste
Range("B238:C239").Select
Application.CutCopyMode = False
Selection.Merge True
Range("D238:P239").Select
Selection.Merge True
Range("B236:P236").Select
Selection.ClearContents
Range("B237:P237").Select
Selection.Font.Bold = False
Selection.Font.Italic = True
Range("B236:P239").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
End If
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
try the below on a copy of your data

Code: 
Sub test()
Dim i As Long, lr As Long
 Sheets("On Market").Select
lr = Sheets("On Market").Range("B" & Rows.Count).End(xlUp).Row
For i = 26 To lr Step 30
If Sheets("On Market").Range("B" & i) < Date - 4 Then
 Range("B" & i & ":P" & i + 2).Copy
 Range("B" & i + 1 & ":C" & i + 1).PasteSpecial
 Range("B" & i + 2 & ":P" & i + 2).Merge True
 
 Range("B" & i & ":P" & i).ClearContents
 Range("B" & i + 1 & ":P" & i + 1).Font.Bold = False
 Range("B" & i + 1 & ":P" & i + 1).Font.Italic = True
 Range("B" & i & ":P" & i + 3).Select
 Selection.Borders(xlDiagonalDown).LineStyle = xlNone
 Selection.Borders(xlDiagonalUp).LineStyle = xlNone
 With Selection.Borders(xlEdgeLeft)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlThin
 End With
 With Selection.Borders(xlEdgeTop)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlThin
 End With
 With Selection.Borders(xlEdgeBottom)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlThin
 End With
 With Selection.Borders(xlEdgeRight)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlThin
 End With
 With Selection.Borders(xlInsideVertical)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlThin
 End With
 With Selection.Borders(xlInsideHorizontal)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlThin
 End With
 Selection.Borders(xlDiagonalDown).LineStyle = xlNone
 Selection.Borders(xlDiagonalUp).LineStyle = xlNone
 With Selection.Borders(xlEdgeLeft)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlMedium
 End With
 With Selection.Borders(xlEdgeTop)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlMedium
 End With
 With Selection.Borders(xlEdgeBottom)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlMedium
 End With
 With Selection.Borders(xlEdgeRight)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlMedium
 End With
 With Selection.Borders(xlInsideVertical)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlThin
 End With
 With Selection.Borders(xlInsideHorizontal)
 .LineStyle = xlContinuous
 .ColorIndex = 0
 .TintAndShade = 0
 .Weight = xlThin
 End With
 End If
Next
End Sub
 
Upvote 0
Thank You, this as made it much smaller however it doesn't Merge the Cells correctly. what i need is Cells B i+1:C i+3 to merge Across and D i+1:P i+3 to merge across
 
Upvote 0
Thanks you for the help BarryL
The below does exactly what i needed thanks :)

Range("B" & i & ":P" & i + 2).Copy
Range("B" & i + 1 & ":C" & i + 1).PasteSpecial
Range("B" & i + 2 & ":C" & i + 2).Merge Across = True
Range("D" & i + 2 & ":P" & i + 2).Merge Across = True
Range("B" & i + 3 & ":C" & i + 3).Merge Across = True
Range("D" & i + 3 & ":P" & i + 3).Merge Across = True
 
Upvote 0
great was just gonna go back. glad to help
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Solved
formating question
Replies
3
Views
299
Micron
M
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
576
RoryA
RoryA
P
  • Question Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
360
6StringJazzer
6StringJazzer
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
1K
kerm007
K
J
  • Question Question
Issue with Macros and renaming files
Replies
6
Views
996
kevin9999
K

Forum statistics

Threads
1,223,236
Messages
6,170,917
Members
452,366
Latest member
TePunaBloke

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