M
Murph
I would like to have a time stamp inserted one column to the right of this
macro. The macro is inserted into an autoshape in Column P, so column Q would
contain the time stamp. The autoshape and macro are repeated in every row of
column P
I am not sure how to, upon clicking the autoshape, make the cell with the
autoshape the active cell and then tell the macro to insert the time stamp
one cell to the right.This is the macro I am currently running.
Sub Barcode()
Dim ActRow As Integer
Dim Iloop As Integer
Application.ScreenUpdating = False
ActRow = ActiveCell.Row
Columns("A:B").Insert
For Iloop = 1 To 6
Cells(Iloop, "A") = Cells(2, Iloop + 2)
Cells(Iloop, "B") = Cells(ActRow, Iloop + 2)
Next Iloop
For Iloop = 12 To 15
Cells(Iloop - 5, "A") = Cells(2, Iloop + 2)
Cells(Iloop - 5, "B") = Cells(ActRow, Iloop + 2)
Next Iloop
Worksheets("Counts").Rows.RowHeight = 40
With Worksheets("Counts").Rows(10)
.RowHeight = .RowHeight * 3
End With
With Worksheets("Counts").Columns("A")
.ColumnWidth = .ColumnWidth * 5
End With
With Worksheets("Counts").Columns("B")
.ColumnWidth = .ColumnWidth * 8
End With
With Worksheets("Counts").Range("A1:B9")
.Font.Size = 30
With Worksheets("Counts").Range("B10")
.Font.Size = 160
End With
End With
Worksheets("Counts").Range("B10").Font.Name = "Free 3 of 9"
Range("A1:B15").PrintOut Copies:=1, Collate:=True
Worksheets("Counts").Rows.RowHeight = 25
Columns("A:B").Delete
Application.ScreenUpdating = False
End Sub
macro. The macro is inserted into an autoshape in Column P, so column Q would
contain the time stamp. The autoshape and macro are repeated in every row of
column P
I am not sure how to, upon clicking the autoshape, make the cell with the
autoshape the active cell and then tell the macro to insert the time stamp
one cell to the right.This is the macro I am currently running.
Sub Barcode()
Dim ActRow As Integer
Dim Iloop As Integer
Application.ScreenUpdating = False
ActRow = ActiveCell.Row
Columns("A:B").Insert
For Iloop = 1 To 6
Cells(Iloop, "A") = Cells(2, Iloop + 2)
Cells(Iloop, "B") = Cells(ActRow, Iloop + 2)
Next Iloop
For Iloop = 12 To 15
Cells(Iloop - 5, "A") = Cells(2, Iloop + 2)
Cells(Iloop - 5, "B") = Cells(ActRow, Iloop + 2)
Next Iloop
Worksheets("Counts").Rows.RowHeight = 40
With Worksheets("Counts").Rows(10)
.RowHeight = .RowHeight * 3
End With
With Worksheets("Counts").Columns("A")
.ColumnWidth = .ColumnWidth * 5
End With
With Worksheets("Counts").Columns("B")
.ColumnWidth = .ColumnWidth * 8
End With
With Worksheets("Counts").Range("A1:B9")
.Font.Size = 30
With Worksheets("Counts").Range("B10")
.Font.Size = 160
End With
End With
Worksheets("Counts").Range("B10").Font.Name = "Free 3 of 9"
Range("A1:B15").PrintOut Copies:=1, Collate:=True
Worksheets("Counts").Rows.RowHeight = 25
Columns("A:B").Delete
Application.ScreenUpdating = False
End Sub