I'm new here but hope you all can help with a solution I'm working towards. I'm working on an excel document and setting up a macro. It works until I try to add some logic to pad a number with zero's.
I'm trying to pad zero's in a select cell where the labels are less than 10, then add my integer. If the labels are greater than 9, I want to pad one less zero, likewise when they are greater than 99, one less from those with 10 or more.
My program asks the user how many labels they wish to print (1-999).
I've tried to add an IF statement within my For I = 1 To LabelCount:
For I = 1 To LabelCount
If I < 10 Then
ActiveSheet.Range("C20").Value = "C906BGM0880000" & I
ActiveSheet.PrintPreview
Else
ActiveSheet.Range("C20").Value = "C906BGM088000T" & I
ActiveSheet.PrintPreview
End If
Next
The above did not work.
Sub IncrementPrint()
'updateby Tyler Garretson
Dim LabelCount As Variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
LInput:
LabelCount = Application.InputBox("Please enter the number of copies you want to print:")
If TypeName(LabelCount) = "Boolean" Then Exit Sub
If (ActiveSheet.Range("F11").Value = "") Or (ActiveSheet.Range("F14").Value = "") Or (ActiveSheet.Range("C18").Value = "") Then
MsgBox "Error Occurred. Please enter values for Route, Stop, and Destination Name", vbExclamation
ElseIf (LabelCount = "") Or (Not IsNumeric(LabelCount)) Or (LabelCount < 1) Or (LabelCount > 999) Then
MsgBox "Error Occurred. Please enter 1 - 999", vbExclamation
ElseIf LabelCount < 10 Then
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To LabelCount
ActiveSheet.Range("C20").Value = "C906BGM0880000" & I
ActiveSheet.PrintPreview
Next
ActiveSheet.Range("C20").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub
User enters 11 labels that he or she wishes to print, the program prints out the following:
Label1: ABC00001
Label2: ABC00002
Label3: ABC00003
Label4: ABC00004
Label5: ABC00005
Label6: ABC00006
Label7: ABC00007
Label8: ABC00008
Label9: ABC00009
Label10: ABC00010
Label11: ABC00011
You want the Format command - Format(1, "00000") = 00001
Format(123,"00000") = 00123
' This might be the basis of what you need
for a = 1 to 1000
b = right("0000000000" & a,8) ' B will always be 8 long and paaded left with 0's
next a
This works well with a text prefix too
for a = 1 to 1000
c = "XYZ" & right("0000000000" & a,8)
next a
Related
I have a code that searches an excel fill for the word distance, takes the value of the cell next to it, paste it into a new cell, then sums all the cells up. Which works great, but i now need to find a way to only sum ever even row number. Does that make sense?
Sub Distance_Check()
Dim DistanceCheck As String
Dim DistanceNumber As String
Dim DistanceSum As String
Dim DistanceTotal As String
DistanceCheck = MsgBox("Would you like to check the distance?", vbYesNo)
If DistanceCheck = vbYes Then
If IsArray(fname) Then Workbooks.OpenText fname(1)
i = 1
findStr = "Distance"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("J" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
Set wkbSourceBook = ActiveWorkbook
DistanceNumber = i - 2
DistanceSum = WorksheetFunction.Sum(Range(Cells(2, 15), (Cells(DistanceNumber + 1, 15))))
DistanceTotal = DistanceSum / DistanceNumber
If DistanceNumber = Cells(2, 12) Then
MsgBox ("No error found wihin distance")
Else
MsgBox ("Error found with distance")
End If
Else
End If
Call Save_Data
End Sub
Would the way youd go about this be using a for loop on the
cells(DistanceNumber(j,+1)
Where j = 0,
j = j +2 ,
Until j > DistanceNumber,
Would that work? If so how would you go about it?
Thanks
A quick way to step through a loop in the desired increments is to use the Mod operator which divides two numbers and returns any remainder (e.g. 7 mod 2 = 1, as two sixes fit into seven, leaving one).
You can use the row property of the range you identify with the Find method, and since you want to jump by two the modulo should be zero:
If foundcel.Row Mod 2 = 0 Then Range("J" & i).value = foundcel.Offset(0, 1).Value
That said, there is a 'built in' way to step through a loop if using a For loop like this
For x = 2 to 10 Step 2
' Do stuff
Next x
You can also use this method to step backwards, e.g.
For x = 100 to 0 Step -10
' Do stuff backwards!
Next x
I am fairly new to VBA programming and how the different data types work, so I am running into a problem. I am adding two different numbers (rng and rng1) in an inputbox. If the user presses cancel the program closes down and the sheet locks. If I use e.g. an integer instead of a variant I can't run the close down code. However, when I try do rng + rng1 it does not add them, but instead glues them together, i.e. if grp = 2 and grp1 = 3 then grp + grp1 = 23. This messes with my plot function. So I am hoping that someone can help me figure out the correct data types to use? Or a different solution to the problem. The code can be seen below.
dim grp As variant
dim grp1 As variant
Application.DisplayAlerts = False
On Error Resume Next
grp = InputBox("Enter No in Group 1")
On Error GoTo 0
Application.DisplayAlerts = True
If grp = "" Then
MsgBox ("User canceled!")
ActiveSheet.Protect Password:="..."
Exit Sub
End If
Application.DisplayAlerts = False
On Error Resume Next
grp1 = InputBox("Enter No in Group 2")
On Error GoTo 0
Application.DisplayAlerts = True
If grp1 = "" Then
MsgBox ("User canceled!")
ActiveSheet.Protect Password:="..."
Exit Sub
End If
ActiveSheet.ChartObjects("Chart1").Activate
With ActiveChart
I = 3
Do Until I = grp + 3
ActiveChart.FullSeriesCollection(I).Select
ActiveChart.SeriesCollection(I).Select
With Selection
.Border.LineStyle = xlContinuous
.Border.Color = RGB(0, 255, 0)
.MarkerBackgroundColor = RGB(0, 255, 0)
.MarkerForegroundColor = RGB(0, 255, 0)
End With
I = I + 1
Loop
j = grp + 3
Do Until j = grp + grp1 + 3
ActiveChart.SeriesCollection(j).Select
With Selection
.Border.LineStyle = xlContinuous
.Border.Color = RGB(0, 0, 255)
.MarkerBackgroundColor = RGB(0, 0, 255)
.MarkerForegroundColor = RGB(0, 0, 255)
End With
j = j + 1
Loop
it does not add them, but instead glues them together, i.e. if grp = 2 and grp1 = 3 then grp + grp1 = 23
InputBox returns a String type. What a lot of people don't realize is that you can use either the & or the + operator to combine strings, and that's what you're doing:
"2" + "3" = "23" '// equivalent to "2" & "3"
Whereas:
2 + 3 = 5
So because your parameters are of type String, the + operator assumes that you're trying to combine them, there's no implicit type conversion to Int or Long or Double, because the operator is perfectly valid for combining strings, which is what you gave it :)
NOTE: It's usually recommended to only use the & operator, that way it's less ambiguous that you're combining strings, versus adding long/integer values.
To handle the resulting input as a numeric type (i.e., to perform addition or other arithmetic operation), then you need to be working with numeric data (Integer/Long/Double type) instead of String type. You could do an explicit typecast like:
Dim grp as Long
grp = CLng(InputBox("Enter No in Group 1"))
Or, more preferably, use the Type argument of the InputBox function:
Dim grp as Long
grp = InputBox("Enter No in Group 1", Type:=1)
Same for grp2.
Because neither input can be 0, this will work for you just fine:
Dim dInput1 As Double
Dim dInput2 As Double
'Use Application.InputBox with Type 1 to force a numeric entry
dInput1 = Application.InputBox("Enter No in Group 1", Type:=1)
If dInput1 = 0 Then Exit Sub 'Pressed cancel
'Use Application.InputBox with Type 1 to force a numeric entry
dInput2 = Application.InputBox("Enter No in Group 2", Type:=1)
If dInput2 = 0 Then Exit Sub 'Pressed cancel
'A simple example showing the values and their sum
MsgBox dInput1 & " + " & dInput2 & " = " & dInput1 + dInput2
Here's a link for more information regarding Application.InputBox
Hi currently i'm having a problem regarding the displaying of the most significant text among 4 rows in one column . What I have here is remarks of clients which is excellent,good,fair and bad ..and i would like to display the word excellent on a cell if it is present in that column , otherwise if good is the highest value present then it should display it ,if fair then fair or and lastly if bad then display bad
enter image description here
Hope this is not too late to answer your question. Try the following formula:
=INDEX({"Bad","Fair","Good","Excellent"},MATCH(1,(MATCH({"Bad","Fair","Good","Excellent"},B2:E2,0)),0))
See the image for reference:
It's not a formula, but the main trouble, as I see, is not to grade four known values you listed above, but to exclude empty and unknown values. Moreover, when such happened, user must be informed about it and make the right decision...
'''''''
Private Sub sb_Test_fp_Grade3()
Debug.Print fp_Grade3(Selection, 1, True)
End Sub
Public Function fp_Grade3(pRng As Range, _
Optional pUnkMod& = 0, _
Optional pEmpDen As Boolean = False) As String
' pUnkMod - Mode of UnKnown grades handling
' 0-Ignore; 1-Info only; 2-Deny
' pEmpDen - Deny or not empty values. If Deny, then empty treated as Unknown
' according pUnkMod setting
Const S_BAD As String = "BAD"
Const S_FAI As String = "FAIR"
Const S_GOO As String = "GOOD"
Const S_EXC As String = "EXCELLENT"
Const S_UNK As String = "UNK" ' UNKNOWN
Dim rCell As Range
Dim lVal&, lMax&, lUnk&
Dim sGrades$(0 To 4), sRet$, sVal$
sGrades(0) = S_UNK
sGrades(1) = S_BAD
sGrades(2) = S_FAI
sGrades(3) = S_GOO
sGrades(4) = S_EXC
lMax = 0
lUnk = 0
sRet = vbNullString
For Each rCell In pRng
sVal = rCell.Value
If (LenB(sVal) > 0 Or pEmpDen) Then
Select Case UCase(rCell.Value)
Case S_BAD: lVal = 1
Case S_FAI: lVal = 2
Case S_GOO: lVal = 3
Case S_EXC: lVal = 4
Case Else: lVal = 0
End Select
Select Case (lVal > 0)
Case True ' Known values
If (lVal > lMax) Then
lMax = lVal
If (lMax = 4) Then
If (pUnkMod = 0) Then Exit For
End If
End If
Case False ' UnKnown values
Select Case pUnkMod
Case 0 ' ignore them
' do nothing
Case 1 ' info about them
lUnk = lUnk + 1
Case Else ' 2 & any others - stop
lMax = 0
Exit For
End Select
End Select
End If
Next
If (lUnk > 0) Then sRet = " & " & lUnk & "x" & S_UNK
sRet = sGrades(lMax) & sRet
fp_Grade3 = sRet
End Function
'''
Good Morning,
I am attempting to create VBA code that will identify if a variable value (number) is found within a string. The string can vary in lenght and can contain 1 or more numbers that are sepearted by a , and a space. I have attempted to use the InStr method but unfortunately if my value is 1 and the string contains a 17 it comes back as true. How can I make it so that would return false since 1 is not equal to 17.
Below is my current code:
'FRB_Code and FRB_Array are variable values within my code but for
'the purpose of this question I have assigned them values.
FRB_Array = "10, 17, 21"
FRB_Code = 1 'ce.Value
If InStr(FRB_Array, FRB_Code) Then
MsgBox "Found"
Else
MsgBox "Not Found"
ce.Delete Shift:=xlUp
End If
Next ce
End If
So the end result should be that the FRB_Code was not found in the FRB_Array and there for the cell was deleted.
Thank you for you help.
You can use an array for that.
Sub FindValue()
Dim sMyString As String
Dim sToFind As String
Dim Arr
Dim i As Long
Dim bFound As Boolean
sMyString = "10, 17, 21"
Arr = Split(sMyString, ", ")
sToFind = "17"
For i = 0 To UBound(Arr)
If Arr(i) = sToFind Then
MsgBox "Found"
bFound = True
Exit For
End If
Next i
If Not bFound Then MsgBox "Not found"
End Sub
Problem is that "1" will "instring" to "1", "217","871", etc. Better to pre-pad and post-pad with spaces:
Sub NumberInString()
BigString = " 1 23 54 79 "
LittleString = " 23 "
MsgBox InStr(1, BigString, LittleString)
End Sub
InStr is not really appropriate here because you are comparing numbers rather than strings. To do what you want split the string into pieces and cycle through the returned array checking each item. Val is used to convert each item in the array to an integer.
bFound = False
FRB_Array = "10, 17, 21"
FRB_Code = 17
ar = Split(FRB_Array, ",")
For i = 0 To UBound(ar)
If FRB_Code = Val(ar(i)) Then
bFound = True
End If
Next i
If bFound Then
MsgBox ("found")
Else
MsgBox ("not found")
End If
You can use REGEX to determine the match.
http://msdn.microsoft.com/en-us/library/twcw2f1c(v=vs.110).aspx
the regex expression would be "1[^\d]|1$" and you would replace 1 with your FB_Code value.
The expression has an or(|) to handle the last number in the array.
I have some vba code to grab information 4 times a minute from a device on it's web configuration page.
I need this to happen from when I place an x in column C and continue until I place an x in column D further down the page.
I have a function I can call which will tell if an X is in the proper place in d, relative to c.
What I'd like to do is have a button which says ok, be ready to scan. then have it start when the first value is entered in c, then stop when the d value is entered.
I'm also having trouble coming up with a way to enter values while the VBA script is actually running.
Any advice? Thanks.
Here is the code to check the columns.
Public Function BackgroundScan(MonitorSpreadsheet As Boolean) As Boolean
Dim LastStart As Integer
Dim LastStop As Integer
intDebug = 1
Select Case MonitorSpreadsheet
Case True
'We are actively testing
If intDebug = 1 Then MsgBox "we ARE monitoring the spreadsheet."
'Call scanning routine here
'Get the status TestingInProgress
LastStart = FindLastStartRow("SVQ")
LastStop = FindLastStopRow("SVQ")
If intDebug = 1 Then MsgBox "LastStart " & LastStart
If intDebug = 1 Then MsgBox "LastStop " & LastStop
Select Case LastStart
Case Is < 20
'We have not started.
If intDebug = 1 Then MsgBox "We have not started."
BackgroundScan = False
'Loop around, and check again
Case Else
'ok we have started, now check to see if we have stopped.
Select Case LastStop
Case Is < LastStart
'**** We ARE testing!!! ****
If intDebug = 1 Then MsgBox "We are testing, and haven't finished."
BackgroundScan = True
Case LastStart
'LastStart and LastStop are the same line, we have started AND finished
If intDebug = 1 Then MsgBox "We have started AND finished!"
BackgroundScan = False
'Loop around, and check again
Case Else
'We have finished testing, and the test spanned multiple rows
BackgroundScan = False
If intDebug = 1 Then MsgBox "We started on one line, and finished on another."
End Select
End Select
Case False
'we are not actively testing
If intDebug = 1 Then MsgBox "We are NOT monitoring the spreadsheet."
BackgroundScan = False
Case Else
MsgBox "Error: Boolean variable reports: " & MonitorSpreadsheet
BackgroundScan = False
End Select
End Function
Here is the code which scans the webpage.
Private Sub CommandButton1_Click()
Dim Some As String 'can't resist a good pun!
Dim intDelay As Integer
Dim intMinDelay As Integer
Dim i As Integer
Dim s As Integer
Dim RunStart As Date
Dim WhichSVBeam As String
Dim lLen As Integer
Dim CurrentSVID As String
Dim CurrentBeamID As String
Dim PreviousSVID As String
Dim PreviousBeamID As String
Dim ColonLocation As Integer
'*******************************************************
'*** Test Continuous Button ***
'*** Where n is specified in cell A6 ***
'*******************************************************
'grab the number of minutes between checking values
intMinDelay = GetValues("A7")
RunStart = Now
'Do this until the end of time, or the execution is halted.
Do 'uncomment do when we are sure the DoEvents will work as we expect
WhichSVBeam = Scan_SVBeam(PreviousSVID, PreviousBeamID)
If InStr(WhichSVBeam, ":") Then
lLen = Len(WhichSVBeam)
ColonLocation = InStr(WhichSVBeam, ":")
'MsgBox WhichSVBeam & ", " & ColonLocation
CurrentSVID = Left(WhichSVBeam, ColonLocation - 1)
'MsgBox CurrentSVID
CurrentBeamID = Right(WhichSVBeam, lLen - ColonLocation)
'MsgBox CurrentBeamID
Else
'no colon, nothing to parse (this shouldn't happen)
MsgBox "No ':' from Scan_SVBeam"
End If
'Call sCheckExecutionTimeGap(RunStart)
'loop for the number of minutes we specified
For i = 1 To intMinDelay
'check every second for events
For s = 1 To 240
Call AppSleep(250)
DoEvents
Next s
Next i
Loop
End Sub
A example of a piece of code that will run at regular intervals, and allows you to change values in your spreadsheet that will be checked, is the following:
Sub testCell()
Dim r1, r2 As Integer
Dim stopIt As Boolean
r1 = doWeStart
r2 = doWeStop(r1)
Debug.Print "The value of cell C1 is now " & [C1].Value
If r1 = 0 Then Debug.Print "We haven't started yet"
If r1 > 0 And r2 = 0 Then Debug.Print "We start but don't stop"
If r1 > 0 And r2 > 0 Then Debug.Print "We started and stopped"
If [C1].Value Like "stop" Or r1 > 0 And r2 > 0 Then stopIt = True Else stopIt = False
If Not stopIt Then
Application.OnTime Now + TimeValue("00:00:05"), "testCell"
End If
End Sub
'
Function doWeStart()
Dim xrow As Integer
' save old selection
Set r = Selection
xrow = 0
' search for "x" in column C
On Error Resume Next
xrow = Application.WorksheetFunction.Match("x", [C:C], 0)
doWeStart = xrow
End Function
'
Function doWeStop(r1)
Dim xrowd As Integer
xrowd = 0
' search for "x" in column D, starting at row r1
On Error Resume Next
xrowd = Application.WorksheetFunction.Match("x", Range("D" & r1, "D1048576"), 0)
If xrowd > 0 Then
doWeStop = xrowd + r1 - 1
Else
doWeStop = 0
End If
End Function
This will run every five seconds, will look for the first "x" in column C and the first "x" in column D below the one found in C. Depending on what is there, it will (for now) print a message in the debug window - you can put your code there. When you enter "stop" in C1, or an "x" is found in both C and D, it stops.
in pseudo code it would be something along th lines of:
start when column c=x
begin loop
get data
check value of column d
if column d= x exit loop
next loop iteration
end
is that what you want?
Philip