Hi just start to learn VBA here.
The additions works just fine. However, division won't work.
It's printing msgbox like the title above any solution?
Sub var_test1()
Dim lngT As Long
Dim lngA As Long
Dim lngB As Long
Dim strA As String
lngA = 10
lngB = 20
strA = " is "
lngT = lngA + lngB
MsgBox lngA & "+" & lngB & strA & lngT
lngT = lngA / lngB
MsgBox lngA & "/" & lngB & strA & lngT
End Sub
Your function runs fine here, but the result by division is zero because of the integer data type.
So, use a data type that allows decimals. Currency is well suited if you need no more than four decimals:
Sub var_test1()
Dim Result As Currency
Dim lngA As Long
Dim lngB As Long
Dim strA As String
lngA = 10
lngB = 20
strA = " is "
Result = lngA + lngB
MsgBox lngA & "+" & lngB & strA & Result
Result = lngA / lngB
MsgBox lngA & "/" & lngB & strA & Result
End Sub
Related
I creted a loop checking number of characters length with conditions but sadly it's not properly working,
with approriate no. of loops but not reading the next line, I want to post the result in a MsgBox,
but when I use the msgbox inside the loop I will get a msgbox for every result found or only one msgbox with one result.
What I would like is to display every result in 1 msgbox with a line vbNewLine after each result.
Below is my code:
Public Sub Rs()
Dim Text As String
Dim NumChar As String
Dim i As Integer
Dim NumRows As Long
Application.ScreenUpdating = False
'Get Cell Value
Text = Range("B2").Value
'Get Char Length
NumChar = Len(Text)
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
Range("B2").Select
For i = 1 To NumRows
'Character length validation
If Len(Text) <= 15 Then
MsgBox Chr(149) & " SVC_DESC " & Text & " has " & NumChar & " characters " & " and it's Valid !" & vbNewLine
Else
MsgBox Chr(149) & " SVC_DESC " & Text & " has " & NumChar & " characters " & " and Exceeded allowable number of characters!" & vbNewLine
End If
Next i
Application.ScreenUpdating = True
End Sub
Assign the new text to a string variable and display the string variable outside the loop:
Option Explicit
Sub TestMe()
Dim i As Long
Dim displayText As String
For i = 1 To 3
displayText = displayText & vbCrLf & i
Next i
MsgBox displayText
End Sub
Build a string through concatenation and display the strings after exiting the loop.
Public Sub Rs()
Dim Text As String
Dim NumChar As String
Dim i As Integer
Dim NumRows As Long
dim msg1 as string, msg2 as string
Application.ScreenUpdating = False
'Get Cell Value
Text = Range("B2").Value
'Get Char Length
NumChar = Len(Text)
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
Range("B2").Select
For i = 1 To NumRows
'Character length validation
If Len(Text) <= 15 Then
msg1 = msg1 & Chr(149) & " SVC_DESC " & Text & " has " & NumChar & " characters " & " and it's Valid !" & vbLF
Else
msg2 = msg2 & Chr(149) & " SVC_DESC " & Text & " has " & NumChar & " characters " & " and Exceeded allowable number of characters!" & vbLF
End If
Next i
Application.ScreenUpdating = True
if cbool(len(msg1)) then
msg1 = left(msg1, len(msg1)-1)
MsgBox msg1
end if
if cbool(len(msg2)) then
msg2 = left(msg2, len(msg2)-1)
MsgBox msg2
end if
End Sub
A MsgBox uses Chr(10) aka vbLF for new lines; vbNewLine is overkill.
I currently have to send multiple letters out at one time and often replace only 1 or two words within a cell. The problem is that I need those words to be bolded and it would be tedious to use this macro individually on 150 worksheets. I am very new to coding and have tried to search online to edit this code to loop through all of the worksheets, but everything I try seems to only change the current sheet I am on. Below is my current code with what I thought would cause the loop, but instead of looping through the worksheets it seems to only loop through the single worksheet I am on, asking if I would like to bold another word on that sheet.
Origanal code:
Sub FindAndBold()
Dim ws As Worksheet
Dim sFind As String
Dim rCell As Range
Dim rng As Range
Dim lCount As Long
Dim iLen As Integer
Dim iFind As Integer
Dim iStart As Integer
On Error Resume Next
Set rng = ActiveSheet.UsedRange. _
SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo ErrHandler
If rng Is Nothing Then
MsgBox "There are no cells with text"
GoTo ExitHandler
End If
sFind = InputBox( _
Prompt:="What do you want to BOLD?", _
Title:="Text to Bold")
If sFind = "" Then
MsgBox "No text was listed"
GoTo ExitHandler
End If
iLen = Len(sFind)
lCount = 0
For Each rCell In rng
With rCell
iFind = InStr(.Value, sFind)
Do While iFind > 0
.Characters(iFind, iLen).Font.Bold = True
lCount = lCount + 1
iStart = iFind + iLen
iFind = InStr(iStart, .Value, sFind)
Loop
End With
Next
If lCount = 0 Then
MsgBox "There were no occurrences of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "to bold."
ElseIf lCount = 1 Then
MsgBox "One occurrence of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "was made bold."
Else
MsgBox lCount & " occurrences of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "were made bold."
End If
ExitHandler:
Set rCell = Nothing
Set rng = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
My most recent attempt:
Sub FindAndBold()
Dim ws As Worksheet
Dim sFind As String
Dim rCell As Range
Dim rng As Range
Dim lCount As Long
Dim iLen As Integer
Dim iFind As Integer
Dim iStart As Integer
For Each ws In ActiveWorkbook.Worksheets
On Error Resume Next
Set rng = ActiveSheet.UsedRange. _
SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo ErrHandler
If rng Is Nothing Then
MsgBox "There are no cells with text"
GoTo ExitHandler
End If
sFind = InputBox( _
Prompt:="What do you want to BOLD?", _
Title:="Text to Bold")
If sFind = "" Then
MsgBox "No text was listed"
GoTo ExitHandler
End If
iLen = Len(sFind)
lCount = 0
For Each rCell In rng
With rCell
iFind = InStr(.Value, sFind)
Do While iFind > 0
.Characters(iFind, iLen).Font.Bold = True
lCount = lCount + 1
iStart = iFind + iLen
iFind = InStr(iStart, .Value, sFind)
Loop
End With
Next
If lCount = 0 Then
MsgBox "There were no occurrences of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "to bold."
ElseIf lCount = 1 Then
MsgBox "One occurrence of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "was made bold."
Else
MsgBox lCount & " occurrences of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "were made bold."
End If
Next ws
ExitHandler:
Set rCell = Nothing
Set rng = Nothing
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub
Corrected working code provided provided by YowE3K:
Sub FindAndBold()
Dim ws As Worksheet
Dim sFind As String
Dim rCell As Range
Dim rng As Range
Dim lCount As Long
Dim iLen As Integer
Dim iFind As Integer
Dim iStart As Integer
For Each ws In ActiveWorkbook.Worksheets
Set rng = Nothing
Set rng = ws.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
If rng Is Nothing Then
MsgBox "There are no cells with text"
GoTo ExitHandler
End If
sFind = InputBox( _
Prompt:="What do you want to BOLD?", _
Title:="Text to Bold")
If sFind = "" Then
MsgBox "No text was listed"
GoTo ExitHandler
End If
iLen = Len(sFind)
lCount = 0
For Each rCell In rng
With rCell
iFind = InStr(.Value, sFind)
Do While iFind > 0
.Characters(iFind, iLen).Font.Bold = True
lCount = lCount + 1
iStart = iFind + iLen
iFind = InStr(iStart, .Value, sFind)
Loop
End With
Next
If lCount = 0 Then
MsgBox "There were no occurrences of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "to bold on worksheet '" & ws.Name & "'."
ElseIf lCount = 1 Then
MsgBox "One occurrence of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "was made bold on worksheet '" & ws.Name & "'."
Else
MsgBox lCount & " occurrences of" & _
vbCrLf & "' " & sFind & " '" & _
vbCrLf & "were made bold on worksheet '" & ws.Name & "'."
End If
Next ws
ExitHandler:
Set rCell = Nothing
Set rng = Nothing
Exit Sub
End Sub
You are setting up a loop to go through each worksheet (using ws as your reference to the sheet currently being processed), but then processing a range on the ActiveSheet. Use ws instead of ActiveSheet.
You should also set rng to Nothing before attempting to set it to the UsedRange.SpecialCells or else, if that crashes, your If rng Is Nothing Then statement won't work (because rng will still be set to whatever it was set to on the previous iteration through the loop).
'...
For Each ws In ActiveWorkbook.Worksheets
Set rng = Nothing
On Error Resume Next
Set rng = ws.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo ErrHandler
If rng Is Nothing Then
'...
I was wondering if there is a way to split a cell with for example 6000 words into 1000 word pieces. So for example, 1000 words in cell C1, then the next 1000 words in C2 and so on.
Here is the code I have so far.
The output of that code (Cell C1) should be split, with C6 with 1000 words, C7 with 1000 words and so on until no more words are available.
Thank you in advance!
Option Explicit
Option Base 1
Dim dStr As String, aCell As Range
Dim cet, i As Long
Sub countWords()
Application.ScreenUpdating = False
Dim iniWords As Long, lWords As Long
Dim wK As Worksheet
On Error GoTo Err
Set wK = ActiveSheet
dStr = Join(WorksheetFunction.Transpose(wK.Range("A1:A" & wK.Range("A" & Rows.Count).End(xlUp).Row).Value), " ")
'iniWords = WorksheetFunction.CountA(wK.Range("A1:A" & wK.Rows.Count))
cet = Split(dStr, " ")
iniWords = UBound(cet)
wK.Range("A1:A" & wK.Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
'lWords = WorksheetFunction.CountA(wK.Range("A1:A" & wK.Rows.Count))
dStr = Join(WorksheetFunction.Transpose(wK.Range("A1:A" & wK.Range("A" & Rows.Count).End(xlUp).Row).Value), " ")
cet = Split(dStr, " ")
dStr = ""
For i = LBound(cet) To UBound(cet)
If Trim(cet(i)) <> "" And InStr(dStr, Trim(cet(i))) = 0 Then
dStr = Trim(dStr) & " " & Trim(cet(i))
End If
Next i
dStr = Trim(dStr)
cet = Split(dStr, " ")
lWords = UBound(cet)
wK.Range("C1") = dStr
Application.ScreenUpdating = True
MsgBox "Words: " & iniWords & vbNewLine & _
"Removed duplicates " & iniWords - lWords & vbNewLine & _
"Remaining Words " & lWords
Exit Sub
Err:
MsgBox "There is no data in row A"
End Sub
you could use this:
Option Explicit
Sub main()
Const NWORDS As Long = 100 '<--| it's the number of words you want each cell to be written with. change it to your needs
Dim strng As String
Dim rowOffset As Long
With Range("C1")
strng = .Value
rowOffset = 5 '<--| point to C7 at the first iteration
Do
strng = Replace(strng, " ", "|", , NWORDS) '<--| "mark" the first NWORDS with a different separator (be sure pipe ("|") is not a character you can have in your words)
.Offset(rowOffset).Value = Replace(Left(strng, InStrRev(strng, "|") - 1), "|", " ") '<--| write first NWORDS words in current 'rowoffset' cell
strng = Right(strng, Len(strng) - InStrRev(strng, "|"))
rowOffset = rowOffset + 1 '<--| update row offset
Loop While UBound(Split(strng, " ")) > NWORDS - 1
.Offset(rowOffset).Value = strng
End With
End Sub
Please note I am not a regular programmer, I have sufficient understanding of coding. I am making a form in which ComboBox1 gives Month, ComboBox2 gives starting date, Combobox3 given ending date.
In the code below, arraystr1 should have values in format - 2, "10/4/2015", 2, "10/5/2015", 2, "10/6/2015", 2, "10/7/2015"
Now my arraystr1 is giving me the values in same format but when I am running the program, its giving me error - "AutoFilter method of Range class falied"
Dim Z As Long
Dim cbstr1 As String
Dim cbstr2 As String
Dim cbstr3 As String
Dim cbstr4 As String
Dim datestr1 As String
Dim datestr2 As String
Dim arraystr1 As String
Dim arraystr2 As String
Dim arraystr3 As String
Dim partstr1 As String
Dim partstr2 As String
partstr1 = " 2,"
partstr2 = ","
arraystr3 = ""
Select Case (ComboBox1.Text)
Case "January"
cbstr2 = "01"
//............//
Case "December"
cbstr2 = "12"
End Select
cbstr3 = ComboBox2.Text
cbstr4 = ComboBox3.Text
datestr1 = cbstr2 & "/" & cbstr3 & "/2015"
datestr2 = cbstr2 & "/" & cbstr4 & "/2015"
If cbstr3 = cbstr4 Then
arraystr1 = partstr1 & Chr(34) & datestr1 & Chr(34)
Else
For Z = cbstr3 To cbstr4
If Z = cbstr4 Then
**arraystr1** = arraystr3 & partstr1 & Chr(34) & datestr2 & Chr(34)
Else
arraystr2 = cbstr2 & "/" & Z & "/2015"
arraystr3 = partstr1 & Chr(34) & arraystr2 & Chr(34) & partstr2
End If
Next Z
End If
MsgBox (arraystr1)
Sheets("Sheet13").UsedRange.ClearContents
Sheets("Full data").Range("$A$1:$AB$45107").AutoFilter Field:=14, Operator:= _
xlFilterValues, Criteria2:=Array(**arraystr1**)
Selection.SpecialCells(xlCellTypeVisible).Select
Sheets("Full data").Select
Range("F:F,L:L,N:N,Q:Q,S:S").Select
Selection.Copy
Sheets("Sheet13").Select
Sheets("Sheet13").Cells(1, 1).Select
Sheets("Sheet13").Paste
Sheets("Sheet13").Range("C:C,E:E").Select
Application.CutCopyMode = False
Selection.NumberFormat = "General"
During launching my macro the Excel application is crashed. If I test the macro with an integer the program runs properly (partnumber = 123). If I check with a string the application is crashed. Thus, no error code is visible for me. I assume that there is a type mismatch (but I set Variant for partnumber)
Sub SbIsInCOPexport()
Dim lastRow As Long
Dim i As Long
Dim found As Boolean
Dim partnumber As Variant
i = 1
found = False
partnumber = ActiveCell.Value
Windows("COPexport.xlsx").Activate
lastRow = Sheets(1).Cells.SpecialCells(xlLastCell).Row
Do While i < lastRow + 1
If Cells(i, 6).Value = partnumber Then
found = True
Exit Do
End If
i = i + 1
Loop
If found = True Then
Cells(i, 6).Select
MsgBox ("Searched part number: " & Str(partnumber) & vbNewLine & "Found part number: " _
& ActiveCell.Value & vbNewLine & "Address: " & Cells(i, 6).Address & vbNewLine & vbNewLine & "Test Order: " & _
Cells(i, 2).Value)
Windows("COPexport.xlsx").Activate
Else
MsgBox "Part number is not found in the COP samples!"
Windows("COPexport.xlsx").Activate
End If
End Sub
What can be the root cause?
I don't see any obvious issues, but consider using the .Find method of range object, like so:
Sub SbIsInCOPexport()
Dim partnumber as Variant
Dim rng as Range
Windows("COPexport.xlsx").Activate
partnumber = ActiveCell.Value
Set rng = Columns(6).Find(partnumber) '## Search in column 6 for partnumber
If rng Is Nothing Then
MsgBox "Part number is not found in the COP samples!"
Windows("COPexport.xlsx").Activate
Else
With rng
MsgBox ("Searched part number: " & Str(partnumber) & vbNewLine & _
"Found part number: " & .Value & vbNewLine & _
"Address: " & .Address & vbNewLine & vbNewLine & _
"Test Order: " & .Offset(0,-4).Value) '## Get the value from column 2
End With
End If
End Sub