Is there a way to put a page number in a cell that updates upon printing?
I set Row 1-5 as to repeat on every page. However, I would like the Page value in Cell F1 to update on each page upon printing. Is there a way to do this?
Thank you.
I think, there's no direct way to increase cell value upon printing.
But you can use VBA, how to use VBA? You can search it.
My question, where's the print out area?
I assume the print area from the same sheet.
Here the code :
Sub forprint()
Dim nPrint As Variant
Dim i, n As Long
On Error Resume Next
n = Range("F1").Value
nPrint = Application.InputBox("Number of Copy", "Print")
If TypeName(nPrint) = "Boolean" Then Exit Sub
If (nPrint = "") Or (Not IsNumeric(nPrint)) Or (nPrint < 1) Then
MsgBox "Enter number only & minimum 1 copy", vbExclamation, "Wrong character or value!"
Else
Application.ScreenUpdating = False
For i = 1 To nPrint
ActiveSheet.Range("F1").Value = n + nPrint
Sheets("Sheet1").PrintOut '<< change Sheet1 to your sheet with the printarea
Next
Application.ScreenUpdating = True
End If
End Sub
Insert Module at VBA window. Click Insert >> Module then paste the code in the Module window, then press F5 to run the code.
Related
I already have a barcode scanner VBA function, that recognizes the barcode number, but the problem I have is that I have to click enter every time, is there any way to do it automatically and store the count in a certain column? Currently it works if I enter the same value stored in column B, it will count the records in column C, but I want to avoid hitting enter every time
This is what I got so far
Private Sub btnAdd_Click()
Dim TargetCell As Range
If WorksheetFunction.CountIf(Sheets("Sheet1").Columns(2), TextBox1.Value) = 1 Then
Set TargetCell = Sheets("Sheet1").Columns(2).Find(TextBox1.Value, , xlValues, xlWhole).Offset(0, 1)
TargetCell.Value = TargetCell.Value + 1
Else
MsgBox "Code not found"
End If
Me.Hide
End Sub
It's hard to say what you have. For example, who presses the button? Or, does your scanner enter a return. I think the code below should work under any circumstances. Please try it.
Private Sub TextBox1_Change()
Dim TargetCell As Range
Dim Qty As Long
With TextBox1
If Len(.Value) = 3 Then
Set TargetCell = Worksheets("Sheet1").Columns(2) _
.Find(.Value, , xlValues, xlWhole)
If TargetCell Is Nothing Then
MsgBox """" & .Value & """ Code not found"
Else
With TargetCell.Offset(0, 1)
Qty = .Value + 1
.Value = Qty
End With
Application.EnableEvents = False
TextBox1.Value = "Count = " & Qty
Application.EnableEvents = True
End If
.SelStart = 0
.SelLength = Len(.Value)
End If
End With
End Sub
I think you have a user form and in this form you have a text box called TextBox1. If so, the code should be in the user form's code module. If you have a text box in your worksheet paste the code to the code module of the sheet on which the text box resides.
Now, you need to adjust this line of code If Len(.Value) = 3 Then to determine when to process the data. This is because the Change event will occur whenever even a single character is entered. I tested with 3 characters. Change the number to a value equal to the length of the numbers you scan in. In theory that still leaves the CR hanging which your scanner might also send. If that causes a problem experiment with >= in place of the = in my code.
The code will add the scan to the existing quantity, just as you had it, and indicate the new total in the text box, in case you are interested. You might replace this with "OK". The code will select the text it enters. Therefore when you enter something else, such as a new scan, it will be over-written without extra clicks being required.
I will admit to being a terrible at code, and have always struggled with Macros... forgive my ignorance.
What I am working on building is a part number index that will create a new sequential number within a numerical series after a macro-button is pressed.
I'd like each button to scan between a range [i.e. 11-0000 (MIN) and 11-9999 (MAX)] and select the max value cell that exists. At that selection point insert an entire new row below with the next + 1 sequential number in the "B" column.
I have my button creating the table row as I would like, however I need help in defining the ".select(=Max(B:B))" and as I understand Max will also limit the # of line items it queries?
I have also been playing with .Range("B" & Rows.CountLarge) with little to no success.
Ideally the 11-**** button [as seen in the screen cap] should insert a sequential number below the highlighted row.
Maybe I'm way over my head, but any guidance even in approach or fundamental structure of the code would help be greatly appreciated!
Private Sub CommandButton1_Click()
Sheets("ENGINEERING-PART NUMBERS").Range("B" & Rows.CountLarge).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveCell.Value = "=ActiveCell + 1"
End Sub
Screen Cap of Spread Sheet
Perhaps there is a simpler solution that I've overlooked, but the below will work.
Insert a module into your workbook and add this code:
Public Sub AddNextPartNumber(ByVal FirstCellInColumn As Range, Optional ByVal PartMask As Variant = "")
Dim Temp As Variant, x As Long, MaxValueFound(1 To 2) As Variant
'Some error checking
If PartMask = "" Then
MsgBox "No part mask supplied", vbCritical
Exit Sub
ElseIf Not PartMask Like "*[#]" Then
MsgBox "Invalid part mask supplied; must end in ""#"".", vbCritical
Exit Sub
ElseIf PartMask Like "*[#]*[!#]*[#]" Then
MsgBox "Invalid part mask supplied; ""#"" must be continuous only.", vbCritical
Exit Sub
End If
'Get the column of data into an array
With FirstCellInColumn.Parent
Temp = .Range(FirstCellInColumn, .Cells(.Rows.Count, FirstCellInColumn.Column).End(xlUp))
End With
'Search through the array and find the largest matching value
For x = 1 To UBound(Temp, 1)
If Temp(x, 1) Like PartMask Then
If MaxValueFound(1) < Temp(x, 1) Then
MaxValueFound(1) = Temp(x, 1)
MaxValueFound(2) = x
End If
End If
Next x
'Output new part number
If MaxValueFound(2) = 0 Then
'This part mask doesn't exist, enter one with 0's at the end of the list
With FirstCellInColumn.Offset(x - 1, 0)
.Value = Replace(PartMask, "#", 0)
.Select
End With
Else
'Get the length of the number to output
Dim NumberMask As String, NumFormatLength As Long
NumFormatLength = Len(PartMask) - Len(Replace(PartMask, "#", ""))
NumberMask = String(NumFormatLength, "#")
'Determine the new part number
MaxValueFound(1) = Replace(MaxValueFound(1), Replace(PartMask, NumberMask, ""), "")
MaxValueFound(1) = Replace(PartMask, NumberMask, "") & Format((MaxValueFound(1) * 1) + 1, String(NumFormatLength, "0"))
'Insert row, add new part number and select new cell
FirstCellInColumn.Offset(MaxValueFound(2), 0).EntireRow.Insert
With FirstCellInColumn.Offset(MaxValueFound(2), 0)
.Value = MaxValueFound(1)
.Select
End With
End If
End Sub
Then, for each button, you write the code like this:
Private Sub CommandButton1_Click()
'this is the code for the [ADD 11-****] button
AddNextPartNumber Me.Range("B16"), "11-####"
End Sub
Private Sub CommandButton2_Click()
'this is the code for the [ADD 22-****] button
AddNextPartNumber Me.Range("B16"), "22-####"
End Sub
This has been written assuming that inserting a new row onto your sheet won't affect other data and that adding new data to the bottom of the table without inserting a row also won't affect other data.
Assuming you're working with a table, by default it should auto-resize to include new data added to the last row.
Good luck learning the ropes. Hopefully my comments help you understand how what I wrote works.
The routine below allows the user to toggle where they have completed/not completed the required entry. The button text changes to Complete/Incomplete and the adjacent cell goes green/red using simple conditional formatting on the 0 or 1 value. Works fine for updating a single line.
The number of data entry rows will vary for each user (say 10 to 100) and I am trying to find a way of selecting and then changing all the buttons in the sheet to "Complete" and updating the adjacent cell to 0 or 1 in one go, should the user want to do that.
Each row is a data entry line and each cell in Column B has a button, and a 0/1 in adjacent cell in Column C.
Sub complete()
'Complete / Incomplete Buttton and Flag
Dim buttontext As String
buttontext = Application.Caller
ActiveSheet.Buttons(Application.Caller).TopLeftCell.Select
ActiveCell.Select
If ActiveSheet.Buttons(buttontext).Caption = "Mark as Incomplete" Then
ActiveSheet.Buttons(buttontext).Caption = "Mark as Complete"
ActiveCell.Offset(0, 1).Value = 1
Else
ActiveSheet.Buttons(buttontext).Caption = "Mark as Incomplete"
ActiveCell.Offset(0, 1).Value = 0
End If
End Sub
Following code works:
Sub MarkAllComplete()
Dim btn As Button
For Each btn In ActiveSheet.Buttons
btn.Caption = "Mark as Complete"
Cells(btn.TopLeftCell.Row, btn.TopLeftCell.Column + 1) = 0
Next
End Sub
Use this concept:
For Each btn In ActiveSheet.Buttons
Debug.Print btn.Name, btn.TopLeftCell.Column, btn.TopLeftCell.Row
Next
I have my cell M2 in Excel which contains a large amount of text. I am trying to figure out a way of making this text scroll right to left continuously.
I have done a lot of looking on the web but all I can find are codes like this which don't make any sense to me and I want to try and make this as simple as possible. Could someone please show me a simple way of getting this to do what I want.
Sub StartMarquee()
Dim sMarquee As String
Dim iPosition As Integer
sMarquee = "This is a scrolling Marquee"
With Me
With .tbMarquee
.Text = ""
For iPosition = 1 To Len(sMarquee)
.Text = .Text & Mid(sMarquee, iPosition, 1)
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 1)
Next iPosition
End With
End With
'Beep
'Application.OnTime Now + TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2), "StartMarquee"
End Sub
While this could be done inside of a for loop in the subroutine, the entire application is going to be locked up while the for loop is executing, which would make it extremely unhelpful.
Instead think of one run of the subroutine as a single iteration. When the sub runs you want it to detect where in the message the marquee is already at in cell M13, and then push the message one more character. That Application.OnTime deal will then schedule the subroutine for its next iteration.
Sub DoMarquee()
Dim sMarquee As String
Dim iWidth As Integer
Dim iPosition As Integer
Dim rCell As Range
Dim iCurPos As Integer
'Set the message to be displayed in this cell
sMarquee = "This is a scrolling Marquee."
'Set the cell width (how many characters you want displayed at once
iWidth = 10
'Which cell are we doing this in?
Set rCell = Sheet1.Range("M2")
'determine where we are now with the message.
' instr will return the position of the first
' character where the current cell value is in
' the marquee message
iCurPos = InStr(1, sMarquee, rCell.Value)
'If we are position 0, then there is no message, so start over
' otherwise, bump the message to the next characterusing mid
If iCurPos = 0 Then
'Start it over
rCell.Value = Mid(sMarquee, 1, iWidth)
Else
'bump it
rCell.Value = Mid(sMarquee, iCurPos + 1, iWidth)
End If
'Set excel up to run this thing again in a second or two or whatever
Application.OnTime Now + TimeValue("00:00:01"), "DoMarquee"
End Sub
Put this into a new Module, in your VBE for the workbook and run it. If you want it to stop then comment out that last line Application.OnTime...
This whole subroutine will run in a flash, so the user of the workbook really shouldn't see it running each second to bump the marquee to the next character.
I have an excel document that has 5 successive cells on 1 column that need to be filled in with data. I am looking to create a VBA userForm that will go through a line of questioning to help the user input the correct data.
Lets say that the 5 cells are A1 through A5. Once the userform is called it should show a question(label maybe?), A text box for the input of data, and a command button to move on the the next question. all the while moving from A1 to A2 and so on until the line of questioning is done.
Does anybody have any idea how to accomplish this? My VB knowledge is basic but i have tried and tried to no avail.
Thanks in advance!
Given a form like this:
You could set your questions up in an array and iterate through them each button press while setting the answers to your sheet.
Dim i As Integer
Dim str(1 To 3) As String
Private Sub UserForm_Initialize()
i = 1
str(1) = "Question 1"
str(2) = "Question 2"
str(3) = "Question 3"
btnNext.Default = True
lblQuestion.Caption = str(i)
txtAnswer.SetFocus
End Sub
Private Sub btnNext_Click()
Sheets("Sheet1").Cells(i, 1).Value = txtAnswer.Text
i = i + 1
If i = UBound(str) + 1 Then
UserForm1.Hide
Exit Sub
End If
lblQuestion.Caption = str(i)
txtAnswer.Text = ""
txtAnswer.SetFocus
End Sub
Example of Result: