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

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
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
74
Micron
M
L
  • Locked
  • Question
Help Cleaning Up Code
Replies
2
Views
332
RoryA
RoryA
P
  • Question
Issue with button not running in spread sheet only in test mode
Replies
1
Views
188
6StringJazzer
6StringJazzer
K
  • Solved
create a button that do actions
2 3
Replies
22
Views
863
kerm007
K
J
  • Question
Issue with Macros and renaming files
Replies
6
Views
503
kevin9999
K

Forum statistics

Threads
1,215,003
Messages
6,122,655
Members
449,091
Latest member
peppernaut

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