How to change this macro

K

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,D4:D18,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
 
D

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.)
 
P

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:D" & 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
 
J

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:D" & 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
 
J

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: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
 
D

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
 
K

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
 
D

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
 
K

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.


Dave Peterson said:
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top