How to change this macro

[KennyD]

Need help changing the range on this range so that it will go to the last
row. For example, instead of going from B2,B4:B18, I need it to go from
B2,B4:"the last row that has any information in it". Same with column D,
Column F and Column H. So I imagine something like B2,B4:B&LastRow. But
don't know how to make that happen. Any help would be greatly appreciated.

Range("B2,B4:B18,D2,D418,F2,F4:F18,H2,H4:H18").Select
Range("H4").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With

 

[Dave Peterson]

Dim LastRow as long

With activesheet
'change the A to whatever column you can use to find the last row
lastrow = .cells(.rows.count,"A").end(xlup).row

with .range("b2,b4:B" & lastrow _
& ",d2,d4:d" & lastrow _
& ",f2,f4:f" & lastrow _
& ",h2,h4:h" & lastrow).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With

end with

(You don't need to select the range to work with it.)

 

[Per Jessen]

Hi

Look at this:

Sub aaa()
Dim Rng1 As Range
Dim Rng2 As Range
Dim LastRow As Long

LastRow = Range("B" & Rows.Count).End(xlUp).Row
Set Rng1 = Range("B2,D2,F2,H2")
Set Rng2 = Range("B4:B" & LastRow & ",D4" & LastRow & _
",F4:F" & LastRow & ",H4:H" & LastRow)

With Rng1.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Rng2.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub

Regards
Per

 

[joemeshuggah]

this is probably an ugly way of doing it...

finalrow = Cells(65536, 2).End(xlUp).Row

Range("B2,D2,F2,H2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Range("B4:B" & finalrow).Select

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Range("D4" & finalrow).Select

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Range("F4:F" & finalrow).Select

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Range("H4:H" & finalrow).Select

With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With


End Sub

 

[Jim Thomlinson]

To be foolproof I would use something like this... Run Test

Sub test()
Intersect(Union(Range("B2"), Range("B4", _
Cells(LastCell.Row, "B"))).EntireRow, _
Range("B:B, D, F:F, H:H").EntireColumn).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End Sub


Public Function LastCell(Optional ByVal wks As Worksheet, _
Optional ByVal blnConstantsOnly As Boolean) As Range
Dim lngLastRow As Long
Dim lngLastColumn As Long
Dim lngLookIn As Long

If blnConstantsOnly = True Then
lngLookIn = xlValues
Else
lngLookIn = xlFormulas
End If

If wks Is Nothing Then Set wks = ActiveSheet
On Error Resume Next
lngLastRow = wks.Cells.Find(What:="*", _
LookIn:=lngLookIn, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
lngLastColumn = wks.Cells.Find(What:="*", _
LookIn:=lngLookIn, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
On Error GoTo 0
If lngLastRow = 0 Then
lngLastRow = 1
lngLastColumn = 1
End If
Set LastCell = wks.Cells(lngLastRow, lngLastColumn)

End Function

 

[Don Guillett]

Sub trythisidea() 'a little different

lr = Cells(Rows.Count, "b").End(xlUp).Row
For i = 2 To 8 Step 2
With Cells(2, i).Resize(lr - 1).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Cells(3, i).Clear
Next i
End Sub

 

[KennyD]

Thank you to all of you for responding so quickly. It's funny that you
responded to this post, Dave, because I have been modifying a macro that you
wrote 2 years ago on this board.

The actual way I got it to work was this (as subroutine in part of a larger
macro):

For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Create a link to the sheet in the B column
Newsh.Cells(RwNum, 2).Formula =
"=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
& """" & Sh.Name & """)"
Newsh.Cells(RwNum, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For Each myCell In Sh.Range("C3,T14,T15") '<--Change the range
ColNum = ColNum + 2
Newsh.Cells(RwNum, ColNum).Formula = "='" & Sh.Name & "'!" &
myCell.Address(False, False)
Newsh.Cells(RwNum, ColNum).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next myCell

But now I need to figure out how to add the word "Totals" in 1 row after the
last row on Column F and then sum the values in Column H from H4:H-LastRow

 

[Dave Peterson]

And you can use the data in column F to determine the last row?

Dim NextRow as long
with worksheets("Somesheethere")
nextrow = .cells(.rows.count,"F").end(xlup).row + 1
.cells(nextrow, "F").value = "Totals"
.cells(nextrow, "H").formular1c1 = "=sum(r4c:r[-1]c)"
end with

Using the .formular1c1 is a very nice way to address that range.

r4c is row 4 of the same column
r[-1]c is one row up (from the totals row) and the same column

Thank you to all of you for responding so quickly. It's funny that you
responded to this post, Dave, because I have been modifying a macro that you
wrote 2 years ago on this board.

The actual way I got it to work was this (as subroutine in part of a larger
macro):

For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
ColNum = 2
RwNum = RwNum + 1
'Create a link to the sheet in the B column
Newsh.Cells(RwNum, 2).Formula =
"=HYPERLINK(""#""&CELL(""address"",'" & Sh.Name & "'!A1)," _
& """" & Sh.Name & """)"
Newsh.Cells(RwNum, 2).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
For Each myCell In Sh.Range("C3,T14,T15") '<--Change the range
ColNum = ColNum + 2
Newsh.Cells(RwNum, ColNum).Formula = "='" & Sh.Name & "'!" &
myCell.Address(False, False)
Newsh.Cells(RwNum, ColNum).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next myCell

But now I need to figure out how to add the word "Totals" in 1 row after the
last row on Column F and then sum the values in Column H from H4:H-LastRow

 

[KennyD]

Thanks Dave. Your stuff you post here is really good. In fact, I am getting
to ready to run another of your macros. But I will post the question that I
have for that macro in another thread. You're the bomb. Really appreciate
it.
--
Nothing in life is ever easy - just get used to that fact.

And you can use the data in column F to determine the last row?

Dim NextRow as long
with worksheets("Somesheethere")
nextrow = .cells(.rows.count,"F").end(xlup).row + 1
.cells(nextrow, "F").value = "Totals"
.cells(nextrow, "H").formular1c1 = "=sum(r4c:r[-1]c)"
end with

Using the .formular1c1 is a very nice way to address that range.

r4c is row 4 of the same column
r[-1]c is one row up (from the totals row) and the same column