Avoid Extra White Space VBA - vba

I have a userform that enters data into another userform, with data being entered on a new line for each submission. I am running into a problem where the 1st entered data skips a line on my userform. How can I adjust my code to avoid having the extra white line in the beginning, here is my code:
Private Sub CommandButton1_Click()
opsvision.opsfinding.Value = opsvision.opsfinding.Value & vbNewLine & "Employees" & "---" & generalbuilder.employees.Value & " -" & Space(2) & Space(1) & """" & Me.findings.Value & """" & Space(5) & "----" & Space(3) & "Finding Conducted by: " & Worksheets("userform").Range("B3") & vbNewLine
Unload Me
End Sub
The red line shows the extra white space at the top of the text box

Test to see if it's empty first. Otherwise you concatenate a vbNewLine to the empty starting value:
Private Sub CommandButton1_Click()
Dim line As String
line = "Employees" & "---" & generalbuilder.employees.Value & " -" & Space(2) & _
Space(1) & """" & Me.findings.Value & """" & Space(5) & "----" & Space(3) & _
"Finding Conducted by: " & Worksheets("userform").Range("B3") & vbNewLine
If opsvision.opsfinding.Value = vbNullString Then
opsvision.opsfinding.Value = line
Else
opsvision.opsfinding.Value = opsvision.opsfinding.Value & vbNewLine & line
End If
Unload Me
End Sub

Related

Displaying all but the last line in a text file

I've created this 2 player game called Go and I've made it so that the statistics from the game is recorded in a text file. If the same 2 players play each other more than once, their game will be recorded in the same text file on the next line.
I have done all of that, but now I want the previous games to be displayed on screen so that the players can see the scores from previous matches. I don't want the final line to be displayed as that is the score from the game that has just finished. Here's my code so far:
Dim file As System.IO.StreamWriter
'Imports the data from previous forms to form 3
handikomi = Form1.handi_komi
prisonerB = Form2.prisonerB
prisonerW = Form2.prisonerW
bpass = Form2.bpass
wpass = Form2.wpass
bstones = Form2.bstones
wstones = Form2.wstones
btotalscore = prisonerB + handikomi(0, 2)
wtotalscore = prisonerW + handikomi(1, 2)
If btotalscore > wtotalscore Then
winnerlbl.Text = (handikomi(0, 0) & " IS THE WINNER!")
ElseIf wtotalscore > btotalscore Then
winnerlbl.Text = (handikomi(1, 0) & " IS THE WINNER!")
End If
file = My.Computer.FileSystem.OpenTextFileWriter("F:\My Go project flood fill2\Text files\" & handikomi(0, 0) & " VS " & handikomi(1, 0) & ".txt", True)
'Displays statistics from current match
file.WriteLine("BLACK" & "," & "WHITE" & "," & "Total Score" & "," & btotalscore & "," & wtotalscore & "," & "Prisoners" & "," & prisonerB & "," & prisonerW & "," & "Passes" & "," & bpass & "," & wpass & "," & "Stones" & "," & bstones & "," & wstones)
file.Close()
breakdwnlbl.Text = " BLACK WHITE"
breakdwnlbl.Text = (breakdwnlbl.Text & vbNewLine & "Total Score" & " " & btotalscore & " " & wtotalscore)
breakdwnlbl.Text = (breakdwnlbl.Text & vbNewLine & "Prisoners" & " " & prisonerB & " " & prisonerW)
breakdwnlbl.Text = (breakdwnlbl.Text & vbNewLine & "Passes" & " " & bpass & " " & wpass)
breakdwnlbl.Text = (breakdwnlbl.Text & vbNewLine & "Stones" & " " & bstones & " " & wstones)
Dim data As String 'to hold value of file line
Dim filename As String 'declare file
filename = "F:\My Go project flood fill2\Text files\" & handikomi(0, 0) & " VS " & handikomi(1, 0) & ".txt" 'path to file on system
FileOpen(1, filename, OpenMode.Input) 'open file for reading
'try amend
Do While Not EOF(1)
data = LineInput(1)
MsgBox(data)
Loop
I think that I shouldn't be using EOF for this case, but I don't know what else to use as I'm still a beginner. I appreciate any help!
Wouldn't it be easier to read all lines and just skip the last one:
Dim allLines() As String = File.ReadAllLines(filename)
Dim allButLast = allLines.Take(allLines.Length - 1)
The variable allButLast is an IEnumerable(Of String) containing all the lines of the file, except for the last one.
Update:
Here's an example to show each line in a MessageBox:
For Each line As String In allButLast
MessageBox.Show(line)
Next

Put formula with if statements in the entire columns

I have recorded a macro with the following formula, but it gives me an error in the second line.
Expected end of statement.
I guess the issue is that its way to long. Please suggest how to make this work?
Sub Macro1()
Range("CG2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC69=""High"",(IF(AND(RC4<>"""",RC5<>"""",RC6<>"""",RC7<>"""",RC8<>"""",RC10<>"""",RC11<>"""",RC12<>"""",RC13<>"""",RC14<>"""",RC16<>"""",RC17<>"""",RC18<>"""",RC19<>"""",RC20<>"""",RC21<>"""",RC22<>"""",RC23<>"""",RC24<>"""",RC25<>"""",RC26<>"""",RC27<>"""",RC28<>"""",RC29<>"""",RC30<>"""",RC31<>"""",RC32<>"""",RC33<>"""",RC34<>"""",RC35<>"""",RC36<>"""",RC37<>"""",RC38<>"""",RC39<>"""",RC40<>"""",RC41<>"""",RC42<>"""",RC43<>"""",RC44<>"""",RC45<>"""",RC46<>""""),""No"",""Yes""))," & Chr(10) & "(IF(RC69=""Medium"",(IF(AND(RC4<>"""",RC5<>"""",RC6<>"""",RC7<>"""",RC8<>"""",RC10<>"""",RC11<>"""",RC12<>"""",RC13<>"""",RC14<>"""",RC16<>"""",RC17<>"""",RC18<>"""",RC19<>"""",RC20<>"""",RC21<>"""",RC22<>"""",RC23<>"""",RC31<>"""",RC32<>"""",RC33<>"""",RC34<>"""",RC35<>"""",RC36<>"""",RC37<>"""",RC38<>"""",RC39<>"""",RC40<>"""",RC41<>"""",RC42<>"""",RC44<>"""",RC45<>"""",RC46<>""""),""No"",""Yes""))," & Chr(10) & "(IF(AND(RC4<>"""",RC5<>"""",RC6<>"""",RC7<>"""",RC8<>"""",RC10<>"""",RC11<>"""",RC12<>""""
""",RC14<>"""",RC16<>"""",RC17<>"""",RC18<>"""",RC19<>"""",RC20<>"""",RC31<>"""",RC32<>"""",RC33<>"""",RC34<>"""",RC35<>"""",RC36<>"""",RC37<>"""",RC38<>"""",RC39<>"""",RC41<>"""",RC42<>"""",RC45<>"""",RC46<>""""),""No"",""Yes"")))))"
End Sub
The issue here is the multiples ", and you also have a different kind of these : “ which do not work!
So replace the " by Chr(34) like this :
Sub formula()
Range("CO2:CO").formula = "=IF(OR(LEN($BN2)=0;$BN2=" & Chr(34) & "Not Performed" & Chr(34) & _
";LEN($BK2)=0;$BK2=" & Chr(34) & "Not Performed" & Chr(34) & _
";LEN($BL2)=0;$Q2=" & Chr(34) & "Not Performed" & Chr(34) & _
";LEN($BM2)=0);" & Chr(34) & "Yes" & Chr(34) & ";" & Chr(34) & _
"No" & Chr(34) & ")"
End Sub

update sh file using VBA before perl script is run

I have a VBA that creates a new directory folder and creates a new text file in that directory. I am trying to run a perl script from the VBA and have created a batch file that gets called from the VBA. That bat file uses a shell file to run a script. The directory in the script is dynamic and changes each time based on user input. My question is can the .sh file be updated before it is run? I apologize for the long post, just wanted to be complete. Thank you :).
VBA
Private Sub CommandButton3_Click()
Dim MyBarCode As String ' Enter Barcode
Dim MyScan As String ' Enter ScanDate
Dim MyDirectory As String
MyBarCode = Application.InputBox("Please enter the barcode", "Bar Code", Type:=2)
If MyBarCode = "False" Then Exit Sub 'user canceled
Do
MyScan = Application.InputBox("Please enter scan date", "Scan Date", Date, Type:=2)
If MyScan = "False" Then Exit Sub 'user canceled
If IsDate(MyScan) Then Exit Do
MsgBox "Please enter a valid date format. ", vbExclamation, "Invalid Date Entry"
Loop
Range("B20").Value = MyBarCode
Range("B21").Value = CDate(MyScan)
MyDirectory = "N:\1_DATA\MicroArray\NexusData\" & MyBarCode & "_" & Format(CDate(MyScan), "m-d-yyyy") & "\"
' Create nexus directory and folder
If Dir(MyDirectory, vbDirectory) = "" Then MkDir MyDirectory
If MsgBox("The project file has been created. " & _
"Do you want to create a template for analysis now?", _
vbQuestion + vbYesNo) = vbYes Then
'Write to text file
Open MyDirectory & "sample_descriptor.txt" For Output As #1
Print #1, "Experiment Sample" & vbTab & "Control Sample" & vbTab & "Display Name" & vbTab & "Gender" & vbTab & "Control Gender" & vbTab & "SpikeIn Location"
Print #1, MyBarCode & "_532Block1.txt" & vbTab & MyBarCode & "_635Block1.txt" & vbTab & ActiveSheet.Range("B8").Value & " " & ActiveSheet.Range("B9").Value & vbTab & ActiveSheet.Range("B10").Value & vbTab & ActiveSheet.Range("B5").Value & vbTab & ActiveSheet.Range("B11").Value & vbTab & ActiveSheet.Range("B12").Value
Print #1, MyBarCode & "_532Block2.txt" & vbTab & MyBarCode & "_635Block2.txt" & vbTab & ActiveSheet.Range("C8").Value & " " & ActiveSheet.Range("C9").Value & vbTab & ActiveSheet.Range("C10").Value & vbTab & ActiveSheet.Range("C5").Value & vbTab & ActiveSheet.Range("C11").Value & vbTab & ActiveSheet.Range("C12").Value
Print #1, MyBarCode & "_532Block3.txt" & vbTab & MyBarCode & "_635Block3.txt" & vbTab & ActiveSheet.Range("D8").Value & " " & ActiveSheet.Range("D9").Value & vbTab & ActiveSheet.Range("D10").Value & vbTab & ActiveSheet.Range("D5").Value & vbTab & ActiveSheet.Range("D11").Value & vbTab & ActiveSheet.Range("D12").Value
Print #1, MyBarCode & "_532Block4.txt" & vbTab & MyBarCode & "_635Block4.txt" & vbTab & ActiveSheet.Range("E8").Value & " " & ActiveSheet.Range("E9").Value & vbTab & ActiveSheet.Range("E10").Value & vbTab & ActiveSheet.Range("E5").Value & vbTab & ActiveSheet.Range("E11").Value & vbTab & ActiveSheet.Range("E12").Value
Close #1
'Run ImaGene
If MsgBox("Please run the ImaGene analysis. " & _
"and click yes after it completes to verify the spike-ins.", _
vbQuestion + vbYesNo) = vbYes Then
**'Update folder structure and call .bat
Dim PathCrnt As String
Dim FN As Long
FN = FreeFile 'FreeFile gets an available file number'
Open "C:\cygwin\home\cmccabe\Run_probes.sh" For Output As FN
PathCrnt = ActiveWorkbook.Path
*system.diagnostics.process.Start ("C:\Users\cmccabe\Desktop\NxClinical.bat") & PathCrnt*
Close FN
End If**
End Sub
Else
MsgBox "Nothing has been done. ", vbExclamation, "Goodbye!"
End If
Application.DisplayAlerts = False
Application.Quit
End Sub
Bat with that calls perl script:
C:\cygwin\bin\bash --login -i ./Run_probes.sh
Run_probes.sh
perl "C:\cygwin\home\cmccabe\get_imagene_spikein_probe_values.pl" "N:\1_DATA\MicroArray\NexusData\*257168310045_8-18-2015*" "ImaGene EmArray- Template.txt" < test_probes8.txt > "N:\1_DATA\MicroArray\NexusData\*257168310045_8-18-2015*\output.txt"
Nice post! Very detailed. :)
Certainly the Perl file can be updated before it is run. Just write the update path into the file like you write the data into sample_descriptor.txt. eg:
Dim FN as Long
FN = FreeFile 'FreeFile gets an available file number'
Open PathToShFile For Output As FN
Print FN, "perl " & chr(34) & PathCrnt & _
& chr(34) & "\get_imagene_spikein_probe_values.pl" & chr(34) & _
& chr(34) & "N:\1_DATA\MicroArray\NexusData\*257168310045_8-18-2015*" & _
chr(34) & " " & chr(34) & _
" ImaGene EmArray- Template.txt" & chr(34) & _
" < test_probes8.txt > " & chr(34) & _
"N:\1_DATA\MicroArray\NexusData\*257168310045_8-18-2015*\output.txt" & chr(34)
Close FN
I'm not sure I got all the " marks replaced with chr(34) correctly so make sure to echo out that string before trying to execute any code. You might also make it more readable (and configurable) by using variables to store paths. eg:
strNPath = "N:\1_DATA\MicroArray\NexusData\*257168310045_8-18-2015*\"

evaluating strings in VBA

I have a string that is read from a cell in Excel, which is something like this:
""Horace Lai" & vbNewLine & Date"
or this
"Chr(149) & "level 1" & vbNewLine & Chr(9) & Chr(149) & "level 2" & Chr(149) & "level 1" & vbNewLine & Chr(9) & Chr(149) & "level 2" & vbNewLine & Chr(9) & Chr(9) & Chr(149) & "level 3""
I would like to be able to evaluate these strings so that ""Horace Lai" & vbNewLine & Date" becomes:
Horace Lai
2014-06-20
So far I have tried ScriptControl without success. It doesn't seem to like it when I have double quotes for the string.
Sub testing()
Dim sc As ScriptControl
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
MsgBox sc.Eval(""Horace Lai" & vbNewLine & Date")
End Sub
The MsgBox line becomes red and I cannot run it.
Any ideas? Thanks
-Horace
You specify JScript, instead:
Dim test As String, result As String
test = "Chr(149) & ""level 1"" & vbNewLine & Chr(9) & Chr(149) & ""level 2"" & Chr(149) & ""level 1"" & vbNewLine & Chr(9) & Chr(149) & ""level 2"" & vbNewLine & Chr(9) & Chr(9) & Chr(149) & ""level 3"""
Dim sc As Object
Set sc = CreateObject("ScriptControl")
sc.Language = "VBScript"
result = sc.Eval(test)
Debug.Print result
•level 1
•level 2•level 1
•level 2
•level 3
Firstly load the name into a variable i.e. name = """Horace Lai""" (this will contain the quote marks)
Then use the replace function to search for quotes in name name = Replace(name,"""","")
Then run the msgbox of MsgBox (name & vbNewLine & Date)
This should remove the extra " marks that you face

Error adding code to workbook via VBA

I am trying to use VBA in Excel to add conditional formatting to a column of a pivot table. The issue is that whenever the pivot table is refreshed, or a filter is changed, etc. the conditional formatting is lost. My solution was to add a macro to the pivot table update event in the workbook, which works ... kinda. It seems that when I run the code that creates the pivot table and adds the code to handle conditional formatting an error occurs but ONLY when the VBA window is NOT open. If the VBA window is open the code executes normally - despite no code changes or reference changes.
Private Sub setupConditionalFormattingForStatusColumn()
Dim thisSheetModule As vbcomponent
Dim formattingCodeString As String
On Error GoTo conditionalFormattingError
formattingCodeString = _
"Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)" & vbNewLine & _
" With Target.parent.Columns(" & harReportColumn("Status") & ")" & vbNewLine & _
" .FormatConditions.AddIconSetCondition" & vbNewLine & _
" .FormatConditions(.FormatConditions.Count).SetFirstPriority" & vbNewLine & _
vbNewLine & _
" With .FormatConditions(1)" & vbNewLine & _
" .IconSet = ActiveWorkbook.IconSets(xl4TrafficLights)" & vbNewLine & _
" .IconCriteria(1).Icon = xlIconYellowExclamation" & vbNewLine & _
vbNewLine & _
" With .IconCriteria(2) " & vbNewLine & _
" .Type = xlConditionValueNumber" & vbNewLine & _
" .value = -1" & vbNewLine & _
" .Operator = 5" & vbNewLine & _
" .Icon = xlIconGreenCircle" & vbNewLine & _
" End With" & vbNewLine & _
vbNewLine & _
" With .IconCriteria(3)" & vbNewLine & _
" .Type = xlConditionValueNumber" & vbNewLine & _
" .value = 1.05" & vbNewLine & _
" .Operator = 7" & vbNewLine & _
" .Icon = xlIconYellowCircle" & vbNewLine & _
" End With" & vbNewLine
formattingCodeString = formattingCodeString & vbNewLine & _
" With .IconCriteria(4)" & vbNewLine & _
" .Type = xlConditionValueNumber" & vbNewLine & _
" .value = 1.15" & vbNewLine & _
" .Operator = 7" & vbNewLine & _
" .Icon = xlIconRedCircleWithBorder" & vbNewLine & _
" End With" & vbNewLine & _
vbNewLine & _
" .ShowIconOnly = True" & vbNewLine & _
" End With" & vbNewLine & _
vbNewLine & _
" .HorizontalAlignment = xlCenter" & vbNewLine & _
" .VerticalAlignment = xlCenter" & vbNewLine & _
" End With" & vbNewLine & _
"End Sub"
Set thisSheetModule = ThisWorkbook.VBProject.VBComponents(harReportSheet.CodeName)
thisSheetModule.CodeModule.AddFromString formattingCodeString
Exit Sub
conditionalFormattingError:
errorLog.logError "WARNING: An error occured while applying the conditional formatting code for the ""Status"" column."
Err.Clear
Resume Next
End Sub
The line which generates the error is: thisSheetModule.CodeModule.AddFromString formattingCodeString but the error is only generated if the VBA window is closed.
Any ideas?
So I was able to find an answer to this issue. Evidently Excel does not properly initialize the codename property of newly created worksheets when the VBA window is not open (the why here is beyond me) but only when it recompiles. A work-around is to force Excel to recompile prior to any calls to the codename property. The solution which worked for me was to place the following code:
On Error Resume Next
Application.VBE.CommandBars.ActiveMenuBar.FindControl(ID:=578).Execute
On Error GoTo conditionalFormattingError
above the line beginning with Set thisSheetModule = ... . Oddly enough the line of code which forces the recompile also throws an error for me which I was able to safely ignore with the surrounding error handling.
More information can be found here: http://www.office-archive.com/2-excel/d334bf65aeafc392.htm
Hope that helps someone out there. :-)