Macros with small difference??

  • Thread starter Thread starter KrisB_bacon
  • Start date Start date
K

KrisB_bacon

I have a macro that fills a column of cells with white and puts N O F I
E L D T R I P S T H I S Y E A R vertically. I want this macro to
run on a different set of cells (for different years, e.g. 2003, 2004
etc.) but with the same actions. Is there a short way of doing this
other than copying and pasting the macro into 6 different macros, just
changing the cell references?


Thx for help people


KrisB_bacon
 
Hi,

If you make the cell reference variable you will be able
to use it how you like without retyping the macro for
different cell's.

Eg. instead of saying range("A1") say activecell, that
why it will run from whereever you are regardless of
sheet.

Hope this helps

Thanks
Wayne
 
there are many ways to do this.

It would help if you pasted the macro code so that we can see what i
the best way to advise you of what changes need to be made.

The main change would involve using a variable in place of the colum
letter within your cod
 
KrisB

One way:

Sub MakeLabel()
Dim vArray(1 To 24) As Variant
Dim i As Integer
Const sText = "NO FIELD TRIPS THIS YEAR"
For i = 1 To Len(sText)
vArray(i) = Mid(sText, i, 1)
Next
Range(ActiveCell, ActiveCell.Offset(23, 0)) = _
Application.WorksheetFunction.Transpose(vArray())
With Range(ActiveCell, ActiveCell.Offset(23, 0)) _
.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
End Sub

Regards

Trevor
 
Here is the macro

Sheets("Classes").Select
Range("H10:H39").Select
Selection.ClearContents
Range("H11:H35").Select
Selection.ClearFormats
Range("H10:H39").Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
Range("H11").Select
ActiveCell.FormulaR1C1 = "N"
Range("H12").Select
ActiveCell.FormulaR1C1 = "O"
Range("H14").Select
ActiveCell.FormulaR1C1 = "F"
Range("H15").Select
ActiveCell.FormulaR1C1 = "I"
Range("H16").Select
ActiveCell.FormulaR1C1 = "E"
Range("H17").Select
ActiveCell.FormulaR1C1 = "L"
Range("H18").Select
ActiveCell.FormulaR1C1 = "D"
Range("H19").Select
ActiveCell.FormulaR1C1 = "T"
Range("H20").Select
ActiveCell.FormulaR1C1 = "R"
Range("H21").Select
ActiveCell.FormulaR1C1 = "I"
Range("H22").Select
ActiveCell.FormulaR1C1 = "P"
Range("H23").Select
ActiveCell.FormulaR1C1 = "T"
Range("H25").Select
ActiveCell.FormulaR1C1 = "H"
Range("H26").Select
ActiveCell.FormulaR1C1 = "I"
Range("H27").Select
ActiveCell.FormulaR1C1 = "S"
Range("H28").Select
ActiveCell.FormulaR1C1 = " "
Range("H29").Select
ActiveCell.FormulaR1C1 = "Y"
Range("H30").Select
ActiveCell.FormulaR1C1 = "E"
Range("H31").Select
ActiveCell.FormulaR1C1 = "A"
Range("H32").Select
ActiveCell.FormulaR1C1 = "R"
Range("H10:H36").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Sheet
Sheets("Fieldtrips").Select
Range("B1").Select
End Sub

I would change each cell reference e.g. H32 to K32 or N32 or Q32 or T3
or W32.

Can you help?

thx

KrisB_baco
 
KrisB

Try this variation

Sub MakeLabel()
Dim vArray(1 To 24) As Variant
Dim i As Integer
Const sText = "NO FIELD TRIPS THIS YEAR"
For i = 1 To Len(sText)
vArray(i) = Mid(sText, i, 1)
Next
With Range(ActiveCell, ActiveCell.Offset(25, 0))
.ClearContents
.ClearFormats
End With
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(24, 0)) = _
Application.WorksheetFunction.Transpose(vArray())
With Range(ActiveCell, ActiveCell.Offset(25, 0)) _
.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
With Range(ActiveCell, ActiveCell.Offset(25, 0))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
End Sub

Regards

Trevor
 
Maybe this is closer to the mark ?

Sub MakeLabel6()
Dim vArray(1 To 24) As Variant
Dim i As Integer
Const sText = "NO FIELD TRIPS THIS YEAR"
For i = 1 To Len(sText)
vArray(i) = Mid(sText, i, 1)
Next
For Each cell In Range("H32, K32, N32, Q32, T32, W32")
With Range(cell, cell.Offset(25, 0))
.ClearContents
.ClearFormats
End With
Range(cell.Offset(1, 0), cell.Offset(24, 0)) = _
Application.WorksheetFunction.Transpose(vArray())
With Range(cell, cell.Offset(25, 0)) _
.Interior
.ColorIndex = 2
.Pattern = xlSolid
End With
With Range(cell, cell.Offset(25, 0))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Next
End Sub

Regards

Trevor
 
Thx

this still looks a bit complicated.

I recieved a bit of help with this before but it didn't work out right
They suggested using this:

NoFieldTrips is the macro described before. The buttons are the year
in which I want the macro to run e.g. btnYear2 = 2003, btnYear3 = 200
etc.

Can my problem be fixed by a similar method to this?

Private Sub btnYear2_Click()
m_Col = 11
NoFieldTrips
End Sub

Private Sub btnYear3_Click()
m_Col = 14
NoFieldTrips
End Sub

Private Sub btnYear4_Click()
m_Col = 17
NoFieldTrips
End Sub

Private Sub btnYear5_Click()
m_Col = 20
NoFieldTrips
End Sub

Private Sub btnYear6_Click()
m_Col = 23
NoFieldTrips
End Sub



Thx peeps



KrisB_baco
 
KrisB

"this still looks a bit complicated" ? Have you tried to run the code ?

The first example will put the message anywhere you want relative to the
active cell. So, attach that code to a button; position the cursor and
press the button.

The second example puts the message in the six columns/locations you
specified.

Whatever, the code will do what you have asked for . Why not try it and
see. And if it's not quite right, try modifying it a little to see what
happens. What can you break ?

The NG can help you so much. Then you have to join in.

Regards

Trevor
 
Back
Top