Good morning, I'm new to this VBA world, and I came across this error in the code below, could someone help me with this (sorry for the google translator).
Error in the firt ReDim
Sub sofar2()
'Dim t As Single
't = Timer
qntinv = Cells(10, 2).Value - 1
maxoverload = Cells(11, 2).Value
vpartida = Cells(12, 2).Value
voperacao = Cells(13, 2).Value
vmpmax = Cells(14, 2).Value
vocmax = Cells(15, 2).Value
minoverload = Cells(16, 2).Value
taminfo = Cells(17, 2).Value - 1
correntemax = Cells(18, 2).Value 'CORRENTE MAXIMA 200
correcaocorrente = 1
folgatrafo = Cells(19, 2).Value
Dim modulo(4) As Double
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim aux As Integer
Dim Infoinv() As Double
Dim Inv() As String
Dim MaxString() As Double
Dim MinMod() As Double
Dim MaxMod() As Double
Dim LimitMod() As Integer
Dim LimitModMPPT() As Double
Dim qntmod() As Integer
Dim limitmodmin() As Double
ReDim Infoinv(taminfo, qntinv)
ReDim Inv(1, qntinv)
'Preenche matriz inversores, verificar qnts inversores existem e dados presentes
For i = 0 To qntinv
For j = 0 To taminfo
Infoinv(j, i) = Worksheets("D.Inv.Comp").Cells(j + 2, i + 3).Value
Next j
Inv(1, i) = Worksheets("D.Inv.Comp").Cells(1, i + 3).Value
Next i
Related
I was working on a project to extract the data from API and Parsing it through the relevant column. The first one is working very fine but its optimizing speed is extremely slow.
so i though to convert it into arrays for fast processing but geeting Run-time error 9 Subscript out of range`
Your help will be much appreciated to fix the issue.
First code with slow optimization.
Dim json As Object
Dim timeEntry As Object
Dim ti As Object
Dim lastRow As Long
Dim myValue As String
Set json = JsonConverter.ParseJson(Data)
i = 2
lastRow = Sheet2.Range("A1").End(xlUp).Row
For Each timeEntry In json("timeentries")
With Sheet2.Cells(i, 1)
.Value = timeEntry("projectName")
.Offset(0, 4).Value = timeEntry("taskName")
.Offset(0, 8).Value = timeEntry("description")
.Offset(0, 9).Value = timeEntry("clientName")
End With
Set ti = timeEntry("timeInterval")
With Sheet2.Cells(i, 1)
.Offset(0, 10).Value = ti("start")
.Offset(0, 6).Value = ti("duration")
End With
i = i + 1
Next timeEntry
Second code with Arrays and getting error
Dim json As Object
Dim timeEntry As Object
Dim ti As Object
Dim lastRow As Long
Dim myValue As String
Set json = JsonConverter.ParseJson(Data)
i = 2
lastRow = Sheet2.Range("A1").End(xlUp).Row
Dim dataArray() As Variant
ReDim dataArray(1 To lastRow, 1 To 12)
For Each timeEntry In json("timeentries")
dataArray(i, 1) = timeEntry("projectName")
dataArray(i, 5) = timeEntry("taskName")
dataArray(i, 9) = timeEntry("description")
dataArray(i, 10) = timeEntry("clientName")
Set ti = timeEntry("timeInterval")
dataArray(i, 11) = ti("start")
dataArray(i, 7) = ti("duration")
i = i + 1
Next timeEntry
Sheet2.Range("A2").Resize(lastRow, 12).Value = dataArray
Size array to number of entries
Sub demo()
Dim json As Object, t As Object
Dim data, i As Long, n As Long
data = "{'timeentries':[" & _
"{'projectName':'Name1','taskName':'Task1','timeInterval':{'start':'08:00','duration':'123'}}," & _
"{'projectName':'Name2','taskName':'Task2','timeInterval':{'start':'09:00','duration':'234'}}," & _
"{'projectName':'Name3','taskName':null,'timeInterval':{'start':'10:00','duration':'345'}}]}"
Set json = JsonConverter.ParseJson(data)
n = json("timeentries").Count
If n < 1 Then
MsgBox "No timeentries in JSON", vbCritical
Exit Sub
End If
Dim dataArray() As Variant
ReDim dataArray(1 To n, 1 To 6)
i = 1
For Each t In json("timeentries")
dataArray(i, 1) = t("projectName") '1
If Not IsNull(t("taskName")) Then
dataArray(i, 2) = t("taskName") '5
End If
dataArray(i, 3) = t("description") '9
dataArray(i, 4) = t("clientName") '10
dataArray(i, 5) = t("timeInterval")("start") '11
dataArray(i, 6) = t("timeInterval")("duration") '77
i = i + 1
Next
' columns
Dim col: col = Array(1, 5, 9, 10, 11, 7)
For i = 0 To UBound(col)
Sheet2.Cells(2, col(i)).Resize(n) = WorksheetFunction.Index(dataArray, 0, i + 1)
Next
End Sub
Thanks for answers. I realize where I made mistakes so I modified a little bit but a new error reminder popped up. It keeps reminding me "expected :(" on "Instra = Instrb + 2" row.
Option Explicit
Sub separate()
Dim instrb As Integer
Dim Instra As Integer
Dim i As Integer
i = 2
Do Until Worksheets(1).Cells(i, "A") = ""
instrb = InStr(Cells(i, "A").Text, "pm")
Instra = Instrb + 2
Cells(i, "B").Value = Right(Worksheets(1).Cells(i, "A"), (Len(Worksheets(1).Cells(i, "A")) - Instra))
i = i + 1
Loop
End Sub
I am a newbie on coding so I know my work looks stupid. What I am trying to do is copy all the words on right side of "pm" in column A and paste into column B. However it keeps reminding me "type mismatch". I think I am doing right so not sure what is going on.
Sub separate()
Dim instrb As Integer
Dim Instra As Integer
Dim i As Integer
i = 2
Do Until Worksheets(1).Cells(i, "A") = ""
instrb = InStr(Cells(i, "A").Text, "pm")
Instra = Instrab + 2
Cells(i, "B").Value = Right(Worksheets(1).Cells(i, "A"), Len(Worksheets(1).Cells(i, "A") - Instra) + 2).Text
i = i + 1
Loop
End Sub
Consider:
Sub separate()
Dim instrbb As Integer
Dim instra As Integer
Dim i As Integer
i = 2
Do Until Worksheets(1).Cells(i, "A") = ""
instrbb = InStr(Cells(i, "A").Text, "pm")
instra = instrbb + 2
Cells(i, "B").Value = Right(Worksheets(1).Cells(i, "A").Text, (Len(Worksheets(1).Cells(i, "A")) - instra + 1))
i = i + 1
Loop
End Sub
But you can simplify with:
Sub separate()
Dim instrbb As Integer
Dim instra As Integer
Dim i As Integer
Dim s As String
i = 2
With Worksheets(1)
Do Until .Cells(i, "A") = ""
s = .Cells(i, "A").Text
.Cells(i, "B").Value = Split(s, "pm")(1)
i = i + 1
Loop
End With
End Sub
NOTES:
avoided using Instrb as a variable as it is a pre-defined VBA function
corrected simple math errors in parsing the string
as others have mentioned, it would be wise to use Long in place of Integer
as others have mentioned, it would be wise to use Option Explicit
I'm very new to excel VBA and i'm making a program for school, but I keep stumbling on error 438 in this code. Can anyone help me out?
I called the function at the end of my code. I'm making a table appear on a new sheet. And the values that will go in the table are calculated from other values from different sheets.
Function TonnageBepalen(kraancapaciteit As Double, transporttijd As Double, ton As Double, aantal As Integer) Dim waarde As Double
waarde = Application.WorksheetFunction.Afronden(8 * 60 / transporttijd, 0) * aantal * ton
TonnageBepalen = Application.WorksheetFunction.Min(kraancapaciteit, waarde)
End Function
Private Sub CommandButton1_Click()
Dim kraan As String
Dim tonkraan As Double
Dim laadtijd As Double
Dim transport As String
Dim tontransport As Double
Dim kmu As Double
Dim lostijd As Double
Dim kraancap As Double
Dim afstand As Double
Dim tijd As Double
Dim tonnage As Double
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim gemsnel As Double
Dim transporttijd As Double
Dim rij As Integer
Dim cell As String
Bladtoevoegen ("transport")
ActiveSheet.Name = "Tabellen transport"
rij = 1
cell = "A" + CStr(rij)
Worksheets("Adres").Activate
afstand = Cells(2, 5).Value
tijd = Cells(2, 6).Value
gemsnel = afstand / (tijd / 60)
Worksheets("transport").Activate
For i = 3 To Cells(1, 8).CurrentRegion.Rows.Count
transport = Cells(i, 8).Value
tontransport = Cells(i, 9).Value
kmu = Cells(i, 10).Value
lostijd = Cells(i, 11).Value
MaakTabelTonnage
Range(cell).Select
ActiveSheet.Paste
rij = rij + 6
Worksheets("kranen").Activate
For j = 3 To Cells(1, 7).CurrentRegion.Rows.Count
kraan = Cells(j, 7).Value
tonkraan = Cells(j, 8).Value
laadtijd = Cells(j, 10).Value
kraancap = tonkraan * 8
Worksheets("Tabellen transport").Activate
transporttijd = Transporttijdbepalen(afstand, kmu, gemsnel, lostijd, laadtijd)
For k = 1 To 15
tonnage = TonnageBepalen(kraancap, transporttijd, tontransport, k)
Cells(rij, k + 3) = tonnage
Next k
rij = rij + 1
Next j
rij = rij + 2
Next i
End Sub
I expect the output to be a double number.
You're using WorksheetFunction together with a local formula name. WorksheetFunction instead uses formulae native to Excel, aka English. I happen to know "Afronden" means "Round".
The function output should also be specified as mentioned by Josh:
Option Explicit
Function TonnageBepalen(kraancapaciteit As Double, transporttijd As Double, ton As Double, aantal As Integer) As Double
Dim waarde As Double
waarde = Application.WorksheetFunction.Round(8 * 60 / transporttijd, 0) * aantal * ton
TonnageBepalen = Application.WorksheetFunction.Min(kraancapaciteit, waarde)
End Function
I have dataset in the format "Ping 172.123.123.123=[150ms]". How can i get the sum of what is within "[" and "]"?. I have many rows and columns and was hoping to get the SUM or AVERAGE of all ping
Example in the screen shot
Assuming that each cell ends with ]
Public Function SumPings(CellsToSum As Range)
Dim runtot As Double
Dim r As Range
Dim x As Integer
Dim y As Integer
Dim s As String
For Each r In CellsToSum
x = InStr(r.Text, "[")
If x > 0 Then
s = Mid(r.Text, x + 1, Len(r.Text) - x - 1)
runtot = runtot + Val(s)
End If
Next r
SumPings = runtot
End Function
This will sum each column and add the total to the last row of each column:
Sub foo()
Dim openPos As Integer
Dim closePos As Integer
Dim midBit As String
Dim Str As String
Dim Extract_value As Integer
LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
LastCol = Sheet1.Cells(1, Sheet1.Columns.Count).End(xlToLeft).Column
x = 1
For x = 1 To LastCol
For i = 1 To LastRow
Str = Sheet1.Cells(i, x).Value
On Error Resume Next
openPos = InStr(Str, "[")
On Error Resume Next
closePos = InStr(Str, "m")
On Error Resume Next
midBit = Mid(Str, openPos + 1, closePos - openPos - 1)
If openPos <> 0 And Len(midBit) > 0 Then
Extract_value = Extract_value + midBit
End If
Sheet1.Cells(LastRow + 1, x).Value = Extract_value
Next i
Next x
End Sub
I am trying parse a number string and create rows accordingly. On the left of the Example Data picture is an example of the input data with the right being my desired output. I am wanting to insert a unique row of data for each digit within the brackets for each number combination.
Here is an example of the code I used to try to solve the problem.
Option Explicit
Sub example()
Dim num As Variant
Dim x As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim test As Variant
Dim test2 As Variant
Dim count As Integer
m = 0
For i = 1 To 3
num = Range("C" & 5 + i + m).Value
For j = 1 To Len(num)
test = Mid(num, j)
If Left(Mid(num, j), 1) = "[" Then
For k = 1 To Len(num) - (j + 1)
m = m + 1
Range("C" & 5 + m + i - 1).EntireRow.Insert
test2 = Left(Mid(num, j + k), 1)
Range("C" & 5 + m + i - 1).Value = Left(num, j - 1) + test2
Next k
End If
Next j
Next i
End Sub
Please consider using the following script:
Sub splitcombinations()
Dim rngCell As Range
Set rngCell = ThisWorkbook.Sheets(1).Range("A2")
Dim strCombinationDigits As String, strBaseDigits As String
Dim intCombinationDigitsLen As Integer
Dim x As Integer
Do While rngCell.Value2 <> ""
If InStr(rngCell.Value2, "[") > 0 Then
strCombinationDigits = Mid(rngCell.Value2, InStr(rngCell.Value2, "[") + 1, InStr(rngCell.Value2, "]") - InStr(rngCell.Value2, "[") - 1)
intCombinationDigitsLen = Len(strCombinationDigits)
strBaseDigits = Left(rngCell.Value2, InStr(rngCell.Value2, "[") - 1)
ActiveSheet.Range(rngCell.Offset(1, 0), rngCell.Offset(intCombinationDigitsLen - 1, 0)).EntireRow.Insert
For x = 1 To intCombinationDigitsLen
rngCell.Offset(x - 1, 0).Value2 = strBaseDigits & Mid(strCombinationDigits, x, 1)
rngCell.Offset(x - 1, 1).Value2 = rngCell.Offset(0, 1).Value2
rngCell.Offset(x - 1, 2).Value2 = rngCell.Offset(0, 2).Value2
Next
End If
Set rngCell = rngCell.Offset(intCombinationDigitsLen , 0)
Loop
End Sub