PDA

View Full Version : Solved: Any way to prevent repeating the same executing code for 4 worksheets?



cavemonkey
06-05-2007, 05:14 PM
Hi.

I have written up a code for my data collection excel. However, my excel file has 4 worksheets full of that data and the code used for these 4 worksheets are the same. Is there any way of shortening the code so that I do not need to repeat the code 4 times for my 4 worksheets?

lucas
06-05-2007, 05:20 PM
It would help to see what your trying to do..
a before and after if possible.

cavemonkey
06-05-2007, 06:26 PM
hmm ok I would post something up. But I think it would be quite messy.
I see what I can do.
Thanks

cavemonkey
06-05-2007, 06:36 PM
Here's the code i wrote:
And this code is supposed to be repeated in 4 of my worksheets.

Option Explicit
Sub test()
Dim lrow As Long
Dim lcol As Long
Dim c As Long
Dim rowcount As Long
Dim acount As Long
Dim a As Long

'Sheets("Report").Select
'rowcount = 1
'Do Until Cells(rowcount, 1) = "Unit"
' rowcount = rowcount + 1
'Loop

' rowcount = rowcount + 2


Sheets("Sheet4").Select
lrow = ActiveSheet.Range("A65536").End(xlUp).Row
lrow = lrow - 1
lcol = ActiveSheet.Range("B16").End(xlToRight).Column
a = 8
b = 0
For c = 2 To lcol
If Cells(lrow, c) > 0 Then
If b = 0 Then
ActiveSheet.Cells(12, c).Copy
Sheets("Report").Select
Cells(a, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet4").Cells(13, c).Copy
Sheets("Report").Select
Cells(a, 2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

b = b + 1


ElseIf b > 0 Then
ActiveSheet.Cells(12, c).Copy
Sheets("Report").Select
Cells(a + 1, 1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet4").Cells(13, c).Copy
Sheets("Report").Select
Cells(a + 1, 2).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

End If

End If

Next c
End Sub

geekgirlau
06-05-2007, 06:59 PM
Option Explicit
Sub test()
Dim wks(1 To 4) As Worksheet
Dim lrow As Long
Dim lcol As Long
Dim c As Long
Dim a As Long
Dim i As Integer


Set wks(1) = Sheet1
Set wks(2) = Sheet2
Set wks(3) = Sheet3
Set wks(4) = Sheet4

For i = 1 To UBound(wks)
wks(i).Select
lrow = ActiveSheet.Range("A65536").End(xlUp).Row - 1
lcol = ActiveSheet.Range("B16").End(xlToRight).Column
a = 8
b = 0
For c = 2 To lcol
If Cells(lrow, c) > 0 Then
wks(i).Cells(12, c).Copy
Sheets("Report").Select
If b = 0 Then
Cells(a, 1).Select
Else
Cells(a + 1, 1).Select
End If
Selection.PasteSpecial Paste:=xlValues
wks(i).Cells(13, c).Copy
Sheets("Report").Select
If b = 0 Then
Cells(a, 2).Select
Else
Cells(a + 1, 2).Select
End If
Selection.PasteSpecial Paste:=xlValues
b = b + 1
End If
Next c
Next i
End Sub

cavemonkey
06-05-2007, 07:38 PM
ok will try it out.

I have a doubt though. what does ubound means?

geekgirlau
06-05-2007, 08:48 PM
Ubound is the upper limit of an array. In this case, there are 4 worksheets to loop through, so it repeats the same code for Sheet1 to Sheet4.

cavemonkey
06-05-2007, 09:43 PM
Alright thanks

unmarkedhelicopter
06-06-2007, 01:57 AM
Alternatively you (cavemonkey) could just look it (ubound) up in the Excel VBA Help :whistle: