I am completely new to EPPlus. I have following code that generates the barchart where bars size changes according to no of rows gets. if only one data row provided it creates one big bar. if I more numbers of data row provided the smaller bar becomes. How do I fix this as single size?
Dim barChart1 As OfficeOpenXml.Drawing.Chart.ExcelBarChart = worksheet5.Drawings.AddChart("BarChart1", OfficeOpenXml.Drawing.Chart.eChartType.ColumnStacked)
barChart1.Style = OfficeOpenXml.Drawing.Chart.eChartStyle.Style27
Dim startColConsumable As String = "D"
Dim startRangeCol As String = "B"
Dim startColIndex As Integer = 10
Dim endColIndex As Integer = totalRow - 1
Dim endRangeCol As String = "C"
Dim startColUncommitted As String = "I"
Dim consumableSeries As OfficeOpenXml.Drawing.Chart.ExcelBarChartSerie = barChart1.Series.Add(worksheet.Cells(String.Concat(startColConsumable, startColIndex.ToString(), ":", startColConsumable, endColIndex.ToString())), worksheet.Cells(String.Concat(startRangeCol, startColIndex.ToString(), ":", endRangeCol, endColIndex.ToString())))
Dim uncommittedSeries As OfficeOpenXml.Drawing.Chart.ExcelBarChartSerie = barChart1.Series.Add(worksheet.Cells(String.Concat(startColUncommitted, startColIndex.ToString(), ":", startColUncommitted, endColIndex.ToString())), worksheet.Cells(String.Concat(startRangeCol, startColIndex.ToString(), ":", endRangeCol, endColIndex.ToString())))
consumableSeries.Header = "Current FY V0 Consumable"
consumableSeries.Fill.Color = System.Drawing.Color.FromArgb(204, 51, 0)
consumableSeries.DataLabel.ShowValue = True
'consumableSeries.DataLabel.ShowLeaderLines = True
uncommittedSeries.Header = "Current FY V0 Uncommitted"
uncommittedSeries.Fill.Color = System.Drawing.Color.FromArgb(51, 153, 255)
uncommittedSeries.DataLabel.ShowValue = True
'uncommittedSeries.DataLabel.ShowLeaderLines = True
barChart1.Title.Text = "FY 2018 Consumable vs Uncommitted"
barChart1.SetPosition(4, 4, 4, 4)
barChart1.XAxis.Title.Text = "Func Area 5 and Fund Center"
barChart1.YAxis.Title.Text = "Amount"
barChart1.XAxis.Title.Font.Size = "15"
barChart1.YAxis.Title.Font.Size = "15"
barChart1.DataLabel.ShowPercent = True
barChart1.SetSize(1540, 880) // fixed chart size
barChart1.DataLabel.ShowValue = True
barChart1.DataLabel.ShowLeaderLines = True
barChart1.DataLabel.Separator = ";"
barChart1.GapWidth = 40 'space between adjacent bars
End If
Thanks In advance.
I tried changing the plot area: That helped me.
If worksheet.Cells(String.Concat(startColConsumable, startColIndex.ToString(), ":", startColConsumable, endColIndex.ToString())).Count = 1 Then
barChart1.SetSize(500, 880)
ElseIf worksheet.Cells(String.Concat(startColConsumable, startColIndex.ToString(), ":", startColConsumable, endColIndex.ToString())).Count = 2 Then
barChart1.SetSize(700, 880)
end if
Related
I have a code that sorts through thousands of lines in a spreadsheet and when it finds a row that has a specific match in two different columns, it returns a value in a third column. However this UDF is used thousands of times and with each running thousands of loops, its very slow. Is there a way to speed up or make this more efficient?
Dim SearchSheet As Worksheet
Dim PN As Integer
Dim MdlCol As Integer
Dim Mdl As String
Dim Result As Integer
Dim FinalRow As Integer
Dim i As Integer
Application.Volatile True
Select Case True
Case Number < WorksheetFunction.CountA(Sheet2.Range("A:A")) And Model = "1A"
Set SearchSheet = Sheet2
PN = 3
MdlCol = 5
Mdl = "1A"
Result = 30
Case Number < WorksheetFunction.CountA(Sheet2.Range("A:A")) And Model = "1B"
Set SearchSheet = Sheet2
PN = 3
MdlCol = 6
Mdl = "1B"
Result = 30
Case Number < WorksheetFunction.CountA(Sheet2.Range("A:A")) And Model = "1C"
Set SearchSheet = Sheet2
PN = 3
MdlCol = 7
Mdl = "1C"
Result = 30
Case Number >= WorksheetFunction.CountA(Sheet2.Range("A:A")) And Model = "1A"
Set SearchSheet = Sheet3
PN = 2
MdlCol = 18
Mdl = "-1A"
Result = 80
Case Number >= WorksheetFunction.CountA(Sheet2.Range("A:A")) And Model = "1B"
Set SearchSheet = Sheet3
PN = 2
MdlCol = 19
Mdl = "-1B"
Result = 80
Case Number >= WorksheetFunction.CountA(Sheet2.Range("A:A")) And Model = "1C"
Set SearchSheet = Sheet3
PN = 2
MdlCol = 20
Mdl = "-1C"
Result = 80
End Select
FinalRow = WorksheetFunction.CountA(SearchSheet.Range("A:A")) + 10
For i = 2 To FinalRow
If SearchSheet.Cells(i, PN) = PartNumber And SearchSheet.Cells(i, MdlCol) = Mdl Then
If SearchSheet.Cells(i, Result).Value = "X" Then
CalibrationRequired = "Y"
Else
CalibrationRequired = SearchSheet.Cells(i, Result).Value
End If
Exit For
End If
Next i
End Function ```
I would suggest:
put LastARow=WorksheetFunction.CountA(SearchSheet.Range("A:A")) once at the start and re-use LastARow rather than repeating the COUNTA many times.
Instead of looping down to final row and looking at each cell in turn, get all the data into a variant array and loop on that
Avoid the VBE UDF slowdown bug by initiating calculation from VBA
I'm trying to locate the variable mismatch in this code for my coworkers VBA code. Yet i've not been able to locate the problem. The code is supposed to update 2 different sheets based on manual inputs in a 3rd sheet. This is in regard to safety hazards.
The debug says this line of code is the one messing up
Previouscellcontentbefore = ActiveCell.Offset(rowbefore + 1, columbefore + 1)
The full code:
Dim I As Integer
Dim row As Integer
Dim before As String
Dim after As String
Dim cons As String
Dim conscat As String
Dim checks As String
Dim check2 As String
Dim check3 As String
Dim rowbefore As String
Dim columbefore As String
Dim rowafter As String
Dim columafter As String
Dim checkbefore As String
Dim checkafter As String
Dim Previouscellcontentbefore As Integer
Dim Previouscellcontentafter As Integer
Sheets("for calculations").Visible = True
cons = Application.InputBox(prompt:="Personnel; Environment; Assets; Reputation; All", Title:="Choose consequence (NB: Case sensitive)", Default:="All")
Worksheets("For calculations").Activate
Range("D37:I42").ClearContents
Range("L37:Q42").ClearContents
Range("C34").ClearContents
Select Case cons
Case "All"
Range("C34").Value = "Risk matrix shows all types of consequences"
Case "Personnel"
Range("C34").Value = "Risk matrix shows all types of Personnel consequences"
Case "Environment"
Range("C34").Value = "Risk matrix shows Environmental consequences"
Case "Asset"
Range("C34").Value = "Risk matrix shows Asset consequences"
Case "Reputation"
Range("C34").Value = "Risk matrix shows Reputation consequences"
End Select
For I = 1 To 200
Range("C47").Value = Worksheets("HAZIDS").Cells(I + 5, 2).Value
conscat = Range("F47")
check2 = cons Like conscat
check3 = cons Like "All"
If cons Like "All" Then
check2 = True
End If
If check2 Then
before = Range("D47")
after = Range("E47")
rowbefore = Mid(before, 2, 1)
columbefore = Mid(before, 4, 1)
rowafter = Mid(after, 2, 1)
columafter = Mid(after, 4, 1)
checkbefore = Not rowbefore Like "" And Not columbefore Like ""
checkafter = Not rowafter Like "" And Not columafter Like ""
If checkbefore Then
Range("C36").Select
Previouscellcontentbefore = ActiveCell.Offset(CInt(rowbefore) + 1, CInt(columbefore) + 1)
ActiveCell.Offset(CInt(rowbefore) + 1, CInt(columbefore) + 1) = Range("C47").Value & ", " & Previouscellcontentbefore
If checkafter Then
Range("K36").Select
Previouscellcontentafter = ActiveCell.Offset(CInt(rowafter) + 1, CInt(columafter) + 1)
ActiveCell.Offset(CInt(rowafter) + 1, CInt(columafter) + 1) = Range("C47").Value & ", " & Previouscellcontentafter
End If
End If
End If
End Sub
I expect the macro to update sheet "Risk matrix before" and "Risk matrix after" based on the manual inputs in "HAZIDS"
Yet the sheet "For calculations" seems to be buggy
You are doing
rowbefore = Mid(before, 2, 1) 'Rownumber in matrix before
columbefore = Mid(before, 4, 1) 'Columnumber in matrix before
And since you didn't declare these variables, they get a string value. (since Mid return a string)
After that in the line indicated by the debug you do this:
Previouscellcontentbefore = ActiveCell.Offset(rowbefore + 1, columbefore + 1)
You are adding integer value 1 to a string value, which doesn't make sense.
What you need to do is use option explicit and properly define your variables.
Then you might need to convert your strings into integers with the function Cint like this
Previouscellcontentbefore = ActiveCell.Offset(Cint(rowbefore) + 1, Cint(columbefore) + 1)
This will only work if your rowbefore and columnbefore actually contain a string that can be converted to an integer. If not you will get an error.
I am working on a macro to pull data of receipts and I need to only find the qty for today's receipts. Using the IBM terminal I bring up an excel worksheet and then proceed to make IBM go to screen I need and then look at the date on the screen and match it to the receipt date. if today's date doesn't match the receipt date on the first page then I need to have the macro press enter and then search the second page for the matching date and so on till the dates match or if they never do stop once the receipt date is blank. My code is below. Not sure where the open function is to not let the code finish. I am a novice and have no idea of formatting code, I apologize in advance.
Thanks for any help you provide.
Sub RMBR()
Dim infile As String
Dim part As String * 19, COMMENT As String * 7, COMMENT2 As String * 2
Dim TDATE As String * 7, PLANT As String * 1
Dim source As String
Dim SELECTION As Integer, i As Integer, c As String
Dim Result As Single
Dim excel As Object
Dim ACELL As Single, BCELL As Single, CCELL As Single, dcell As Single
Dim Verify As Single
infile = InputBox$("input FILE NAME INCLUDING PATH?", "FILE NAME", "C:\CFILES\rmbr.XLSX")
TDATE = InputBox$("Input Status", "TDATE", "CURRENT")
i = 2
Set excel = CreateObject("EXCEL.APPLICATION")
excel.Visible = True
excel.Workbooks.Open FileName:=infile
Verify = MsgBox("IS THIS THE CORRECT SPREADSHEET?", 4, "VERIFY SPREADSHEET")
ACELL = "A2"
BCELL = "B2"
CCELL = "C2"
DCELL = "D2"
excel.Range("A1").Select
excel.activecell.FormulaR1C1 = "PARTNO"
excel.Range("B1").Select
excel.activecell.FormulaR1C1 = "RMBR QTY"
excel.Range("C1").Select
excel.activecell.FormulaR1C1 = " "
excel.Range("D1").Select
excel.activecell.FormulaR1C1 = "TODAY'S DATE"
excel.Range(ACELL).Select
part = excel.activecell.FormulaR1C1
excel.Range(BCELL).Select
PLANT = excel.activecell.FormulaR1C1
excel.Range(CCELL).Select
COMMENT = excel.activecell.FormulaR1C1
excel.Range(dcell).Select
COMMENT2 = excel.activecell.FormulaR1C1
Do Until partnumber = " "
With Session
.TransmitTerminalKey rcIBMClearKey
.WaitForEvent rcKbdEnabled, "30", "0", 1, 1
.WaitForEvent rcEnterPos, "30", "0", 1, 1
.TransmitANSI "RMBR"
.TransmitTerminalKey rcIBMEnterKey
.WaitForEvent rcKbdEnabled, "30", "0", 1, 1
'.WaitForEvent rcEnterPos, "30", "0", 2, 6
.WaitForDisplayString "FN:", "30", 2, 2
.MoveCursor 4, 11
.TransmitANSI part
.TransmitTerminalKey rcIBMEnterKey
.WaitForEvent rcKbdEnabled, "30", "0", 1, 1
Date = .GetDisplayText(4, 73, 8)
RIP.Date = .GetDisplayText(9, 73, 8)
Dim n As Integer
For n = 9 To 22
Do Until Date = RIP.Date
Date = .GetDisplayText(9, 73, 8)
RIP.Date = .GetDisplayText(n, 73, 8)
Loop
If Date = RIP.Date Then
Result = .GetDisplayText(n, 32, 6)
excel.Range(BCELL).Select
excel.activecell.FormulaR1C1 = Result
End If
If Date <> RIP.Date Then
.TransmitTerminalKey rcIBMEnterKey
End If
Do Until Date = RIP.Date
Date = .GetDisplayText(9, 73, 8)
RIP.Date = .GetDisplayText(n, 73, 8)
Loop
Do Until RIP.Date = " "
Loop
i = i + 1
c = Trim$(Str$(i))
ACELL = "A" + c
BCELL = "B" + c
CCELL = "C" + c
excel.Range(ACELL).Select
part = excel.activecell.FormulaR1C1
excel.Range(BCELL).Select
PLANT = excel.activecell.FormulaR1C1
excel.Range(CCELL).Select
COMMENT = excel.activecell.FormulaR1C1
excel.Range(dcell).Select
COMMENT2 = excel.activecell.FormulaR1C1
End With
End Sub
There are quite some issues in your code, let's have a look:
Plenty of this:
excel.Range("A1").Select
excel.activecell.FormulaR1C1 = "PARTNO"
You can replace this by (far more readable):
excel.Range("A1").FormulaR1C1 = "PARTNO"
First:
i = 2
ACELL = "A2"
And later:
i = i + 1
c = Trim$(Str$(i))
ACELL = "A" + c
You can use this at the beginning too, so replace the first one by:
i = 2
c = Trim$(Str$(i))
ACELL = "A" + c
For-loop is not ended:
For n = 9 To 22
...
(Where's the Next, or the Step?)
Possible endless loop:
Do Until RIP.Date = " "
Loop
(Two things: this is a possible endless loop, and second, what's with the list of spaces? You'd better say "... until Trim$(RIP.Date) = """)
Also the large loop is not ended:
Do Until partnumber = " "
(same comment as above)
Please correct your code further (as your code does not even compile, it's almost impossible to help you further).
In top of this I see that you are mixing small letters and capitals. In Excel this is not a problem but other programming languages might have a problem with that. Please get a good habit of using the same "capitalising" system for all your variables.
I'd like to generate elements (checkboxes and textboxes) from a module to a userform in the number of the array elements which the array have. Example:
array4()
array4(1): "Peter Meier"
array4(2): "Joe Garner"
array4(3): "Phil Master"
and so on
array2()
array2(1): 2
array2(1): 2
array2(2): 6
array2(3): 160
and so on
Both arrays have always the same number of arrays.
The Userform should show afterwoods:
Checkbox / Textfield.Text = Peter Meier / Textfield.Text = 2
Checkbox / Textfield.Text = Joe Garner / Textfield.Text = 6
and so on
and so on
Regards,
Yab86
Might be more elegant to store both values in same array?
array(1,1) = "Peter Meier"
array(1,2) = "2"
array(2,1) = "Joe Garner"
array(2,2) = "2"
etc...
As for your problem, something like this maybe:
Sub Stuff()
Dim vrData(2, 1) As Variant ' or vrData() and redim later
Dim ctControl As Control
Dim intPosX, intPosY As Integer
Dim ufForm As BlankForm ' i.e. a blank userform you create first
vrData(0, 0) = "Whatever"
vrData(0, 1) = "3"
vrData(1, 0) = "Something"
vrData(1, 1) = "2"
vrData(2, 0) = "Horse"
vrData(2, 1) = "7"
intPosX = 20
intPosY = 20
Set ufForm = New BlankForm
For i = 0 To UBound(vrData, 1)
Set ctControl = ufForm.Controls.Add("Forms.CheckBox.1")
With ctControl
.Caption = vrData(i, 0)
.Left = intPosX
.Top = intPosY
End With
Set ctControl = ufForm.Controls.Add("Forms.TextBox.1")
With ctControl
.Text = vrData(i, 1)
.Left = intPosX + 100
.Top = intPosY
End With
intPosY = intPosY + 20
Next
ufForm.Show
End Sub
I have a string of the following shape:
RRP 90 AVE DE GAULLE 92800 PUTEAUX 0109781431-0149012126
The numbers might be seperated by other chars than hyphens (eg spaces). I know how to differentiate them afterwards with len().
I need every string of numbers to be stored seperately (in an array for example), so that I can discriminate them with len() and then use them.
I have found how to strip the characters away from the string :
How to find numbers from a string?
But it doesn't suit my problem...
Could you direct me to a function or bit of code that could help me with that?
This will run much faster than looping
Public Function NumericOnly(s As String) As String
Dim s2 As String
Dim replace_hyphen As String
replace_hyphen = " "
Static re As RegExp
If re Is Nothing Then Set re = New RegExp
re.IgnoreCase = True
re.Global = True
re.Pattern = "[^0-9 -]" 'includes space, if you want to exclude space "[^0-9]"
s2 = re.Replace(s, vbNullString)
re.Pattern = "[^0-9 ]"
NumericOnly = re.Replace(s2, replace_hyphen)
End Function
Try below code :
Function parseNum(strSearch As String) As String
' Dim strSearch As String
'strSearch = "RRP 90 AVE DE GAULLE 92800 PUTEAUX 0109781431-0149012126"
Dim i As Integer, tempVal As String
For i = 1 To Len(strSearch)
If IsNumeric(Mid(strSearch, i, 1)) Then
tempVal = tempVal + Mid(strSearch, i, 1)
End If
Next
parseNum = tempVal
End Function
So I realize this was a long time ago... but I was looking for a similar solution online.
Some previous history on my programming skillz (sic): I started with Python and with Python I have a handy tool called List. VBA doesn't have this, so what I'm left with is something that I can input in a variable I called sample below, i.e. sample = [1,4,5].
Back to the small code. I made it so holder would only contain groups of numbers, as how you specified they should be grouped.
Dim count, count1 As Integer
Dim holder As String
Dim sample, smallSample As String
count = 0
count1 = 1
sample = "1ab33 efa 123 adfije-23423 123124-23423"
holder = ""
Do While count <> Len(sample)
smallSample = Left(sample, 1)
If smallSample = "0" Or smallSample = "1" Or smallSample = "2" Or smallSample = "3" Or smallSample = "4" Or smallSample = "5" Or smallSample = "6" Or smallSample = "7" Or smallSample = "8" Or smallSample = "9" Then
holder = holder & smallSample
Else
If holder <> "" Then
Cells(count1,1) = holder
count1 = count1 + 1
End If
holder = ""
End If
sample = Right(sample, Len(sample) - 1)
Loop
The output I got was
1
33
123
23423
123124
after I ran the code.
Great Simple Python-style loop above.
Extended for a list of strings in column A.
The numbers discovered will show in the columns to the right - B, C, etc.
Dim count, count1 As Integer
Dim holder As String
Dim sample, smallSample As String
Dim r As Integer
Dim c As Integer
r = 1
c = 1
Do While Sheet2.Cells(r, c) <> ""
count = 0
count1 = 1
sample = Sheet2.Cells(r, c)
holder = ""
Do While count <> Len(sample)
smallSample = Left(sample, 1)
If smallSample = "0" Or smallSample = "1" Or smallSample = "2" Or smallSample = "3" Or smallSample = "4" Or smallSample = "5" Or smallSample = "6" Or smallSample = "7" Or smallSample = "8" Or smallSample = "9" Then
holder = holder & smallSample
Else
If holder <> "" Then
Sheets(2).Cells(r, c + count1).Value = holder
count1 = count1 + 1
End If
holder = ""
End If
sample = Right(sample, Len(sample) - 1)
Loop
r = r + 1
Loop
If you are getting the Error "Issue while compiling, user defined type not defined" while using #Scotts Answer Enable the Regular Expression option as seen in Step 1 and 2 here: How to Use/Enable (RegExp object) Regular Expression using VBA (MACRO) in word (Works in Excel also)
P.s. Scotts Solution worked well for me.