PDA

View Full Version : Solved: Combining macros



Pete
06-17-2008, 07:48 AM
Hi Experts

It is possible to run the below macro code for the following worksheet(s):-

Allocation (Vol), Allocation (Vol) and Alloc (Sc.1), Alloc (Sc.2), Alloc (Sc.3)

as you can see i have five macro going to five differnet worksheet(s) the macro is slow and i want is just slight speed it up.......


Sub concat_sc1()
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long

rowe = 6
str1 = "B"
str2 = "B"
With Sheets("Alloc (Sc.1)")
Set rng = Range(.Cells(rowe, str1), .Cells(.Cells.Rows.Count, str2).End(xlUp))
End With

For Each celle In rng
If celle <> "" Then
celle.Offset(0, 3).FormulaR1C1 = "=VLookup(RC[-3],'Deal Selection'!R9C2:R58C2,1,FALSE)"
celle.Offset(0, 3) = "Vol_" & CStr(celle.Offset(0, 3))
If str1 <> celle.Offset(0, 3) Then
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With celle.Offset(0, 3).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

EDIT: Added VBA Tags - Tommy

Bob Phillips
06-17-2008, 08:48 AM
Sub concat_sc1()
Dim sh As Worksheet
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long

For Each sh In Worksheets(Array("Allocation (Vol)", _
"Allocation (Vol) and Alloc (Sc.1)", "Alloc (Sc.2)", "Alloc (Sc.3)"))

rowe = 6
str1 = "B"
str2 = "B"
With sh
Set rng = Range(.Cells(rowe, str1), .Cells(.Cells.Rows.Count, str2).End(xlUp))
End With

For Each celle In rng

If celle <> "" Then

celle.Offset(0, 3).FormulaR1C1 = "=VLookup(RC[-3]," _
'Deal Selection'!R9C2:R58C2,1,FALSE)"
celle.Offset(0, 3) = "Vol_" & CStr(celle.Offset(0, 3))
If str1 <> celle.Offset(0, 3) Then

celle.Borders(xlEdgeTop).LineStyle = xlNone
With celle.Offset(0, 3).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With


'...
Next sh

Edit Lucas: Line breaks added.....

Pete
06-17-2008, 10:31 AM
thanks for the feed back XLD..............
let me test it and get back you

Pete
06-17-2008, 10:36 AM
ok get a compile without next error


Sub concat_sc1()
Dim sh As Worksheet
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long

For Each sh In Worksheets(Array("Allocation (Vol)", _
"Allocation (Vol) and Alloc (Sc.1)", "Alloc (Sc.2)", "Alloc (Sc.3)"))

rowe = 6
str1 = "B"
str2 = "B"
With sh
Set rng = Range(.Cells(rowe, str1), .Cells(.Cells.Rows.Count, str2).End(xlUp))
End With

For Each celle In rng

If celle <> "" Then

celle.Offset(0, 3).FormulaR1C1 = "=VLookup(RC[-3],'Deal Selection'!R9C2:R58C2,1,FALSE)"
celle.Offset(0, 3) = "Vol_" & CStr(celle.Offset(0, 3))
If str1 <> celle.Offset(0, 3) Then

celle.Borders(xlEdgeTop).LineStyle = xlNone
With celle.Offset(0, 3).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
str1 = celle.Offset(0, 3)
End If
celle.Offset(0, 3).FormulaR1C1 = "=VLookup(RC[-2],'Deal Selection'!R9C9:R58C9,1,FALSE)"
celle.Offset(0, 3) = str1 & " _" & CStr(celle.Offset(0, 3))
End If
Next celle
End Sub


EDIT: Added the VBA tags Tommy

lucas
06-17-2008, 10:49 AM
shouldn't this be next sh
Next celle

Pete
06-17-2008, 10:55 AM
changed it

Say "invaild Next control varibale reference"

figment
06-17-2008, 11:21 AM
add a Next before the End Sub

Tommy
06-17-2008, 11:35 AM
Per everone's comments

Sub concat_sc1()
Dim sh As Worksheet
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long
For Each sh In Worksheets(Array("Allocation (Vol)", _
"Allocation (Vol) and Alloc (Sc.1)", "Alloc (Sc.2)", "Alloc (Sc.3)"))
rowe = 6
str1 = "B"
str2 = "B"
With sh
Set rng = Range(.Cells(rowe, str1), .Cells(.Cells.Rows.Count, str2).End(xlUp))
End With
For Each celle In rng
If celle <> "" Then
celle.Offset(0, 3).FormulaR1C1 = "=VLookup(RC[-3],'Deal Selection'!R9C2:R58C2,1,FALSE)"
celle.Offset(0, 3) = "Vol_" & CStr(celle.Offset(0, 3))
If str1 <> celle.Offset(0, 3) Then
celle.Borders(xlEdgeTop).LineStyle = xlNone
With celle.Offset(0, 3).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
str1 = celle.Offset(0, 3)
End If
celle.Offset(0, 3).FormulaR1C1 = "=VLookup(RC[-2],'Deal Selection'!R9C9:R58C9,1,FALSE)"
celle.Offset(0, 3) = str1 & " _" & CStr(celle.Offset(0, 3))
End If
Next celle
Next sh
End Sub



It helps to post the whole sub to begin with so there is no confusion on anyone's part. :)

EDIT: Fixed my own stuff LOL Tommy

Pete
06-17-2008, 01:05 PM
error with this line:

For Each sh In Worksheets(Array("Allocation (Vol)", _
"Allocation (Vol) and Alloc (Sc.1)", "Alloc (Sc.2)", "Alloc (Sc.3)"))

Tommy
06-17-2008, 01:34 PM
If the error is subscript out of range it is because one of the sheets does not exist.

Otherwise tells us what the error is and we may be able to help more. :)

Pete
06-17-2008, 01:37 PM
syntax error
For Each sh In Worksheets(Array("Allocation (Vol)", _

Tommy
06-17-2008, 02:01 PM
I don't get the error, I did test it so try this
For Each sh In Worksheets(Array("Allocation (Vol)", "Allocation (Vol) and Alloc (Sc.1)", "Alloc (Sc.2)", "Alloc (Sc.3)"))

Bob Phillips
06-17-2008, 02:02 PM
I am unable to name a sheet 'Allocation (Vol) and Alloc (Sc.1)', it is too long. How did you manage?