I need to copy columns of y-values from a sheet called "Matrix" and paste them into a sheet called "All Normalized", format is not a concern, but the number of columns isn't just 10 but unlimited.
I need to copy the values from Matrix as a column and divide each cell by the first number in the column to normalize it (first value starts at row 3). And I keep getting this error:"Runtime error '6'- Overflow".
How can I fix this error and properly normalize the data?
Sub NewNorm()
Set WB = ThisWorkbook
Application.ScreenUpdating = False
'X-Values
With WB.Sheets("All Normalized")
[A3].Value = 0
[A4].Value = 1E-18
[A5].Value = 0.0001
[A6].Value = 0.001
[A7].Value = 0.01
[A8].Value = 0.5
[A9].Value = 1
[A10].Value = 2
[A11].Value = 3
[A12].Value = 4
[A13].Value = 5
[A14].Value = 6
[A15].Value = 7
[A16].Value = 8
[A17].Value = 9
[A18].Value = 10
[A19].Value = 20
[A20].Value = 30
[A21].Value = 40
[A22].Value = 50
[A23].Value = 60
[A24].Value = 70
[A25].Value = 80
[A26].Value = 90
[A27].Value = 100
[A28].Value = 150
[A29].Value = 175
[A30].Value = 180
[A31].Value = 185
[A32].Value = 190
[A33].Value = 200
[A34].Value = 300
[A35].Value = 400
[A36].Value = 500
[A37].Value = 1000
End With
Dim ColumnCount As Integer
ColumnCount = 10
Dim Colum As Long
For Columz = 2 To columnz 'Loop through each cell, normalizing
For rowz = 3 To 10
Sheets("All Normalized").Cells(rowz, Columz).Value = Sheets("Matrix").Cells(rowz, Columz).Value / Sheets("Matrix").Cells(3, Columz).Value 'ERROR HERE
Next rowz
Next Columz
Application.ScreenUpdating = True
End Sub
Your narratuive,
...divide each cell by the first number in the column ...
Your data,
[A3].Value = 0
[A4].Value = 1E-18
[A5].Value = 0.0001
[A6].Value = 0.001
...
Your code,
Sheets("All Normalized").Cells(rowz, Columz).Value = _
Sheets("Matrix").Cells(rowz, Columz).Value / Sheets("Matrix").Cells(3, Columz).Value
You cannot divide a number by zero. It results in an overflow error.
Related
I have slow performing procedure, it's job is to format sheets in workbook. Mainly to adjust row heights and column widths, apply number formats for columns, plane freezes and to remove autofilters. It is long, and I have deleted several similar parts to shorten it for stackoverflow, but there are no big loops, excel workbook has only several sheets and I have tried to identify slow performing part with timer, but without luck. Any ideas? Is any of these operations extra slow? It takes around 1 minute and 20 seconds to format sheets. It is quite similar to other procedures that are working with data in cells, seems to long, for cosmetic adjustments.
'Procedure to format sheets
Private Sub FormatSheets()
Dim ShHead(1 To 22) As Variant
Dim ShHead2(1 To 19) As Variant
Dim i As Long
Dim Sh As Worksheet
'Creates array of column Headers for sheets "Data", "Process", "Delete"
ShHead(1) = "BizReg_UUK": ShHead(2) = "VDVV_UUK1": ShHead(3) = "VDVV_UUK"
ShHead(4) = "VDVV_NMK": ShHead(5) = "BizReg_Nos": ShHead(6) = "VDVV_Nos"
ShHead(7) = "BizReg_NACE1_2_red": ShHead(8) = "VDVV_NACE_2_red": ShHead(9) = "Nace maiņa"
ShHead(10) = "Nace maiņas avots": ShHead(11) = "BizReg_LKV": ShHead(12) = "VDVV_LKV"
ShHead(13) = "AVG Apgr.": ShHead(14) = "AVG Darb.": ShHead(15) = "VDVV_Adr"
ShHead(16) = "Struktūras": ShHead(17) = "Sākums": ShHead(18) = "Beigas"
ShHead(19) = "Nodarbošanās": ShHead(20) = "NACE": ShHead(21) = "Change it!"
ShHead(22) = "Reason"
'Creates header for sheets "NoResult", "Result"
For i = 1 To 19
If i = 1 Then
ShHead2(i) = ShHead(i)
Else
ShHead2(i) = ShHead(i + 3)
End If
Next
'Loops all sheets in workbook and removes filters, if they exist before data are processed
For Each Sh In ThisWorkbook.Worksheets
If Sh.AutoFilterMode = True Then
Sh.AutoFilterMode = False
End If
Next Sh
'Formating sheet "Result"
With ThisWorkbook.Sheets("Result")
'Clears whole sheet
.UsedRange.Clear
'Text in first row set to bold
.Range("A4:S4").Font.Bold = True
'Creates filter
.Range("A4:S4").AutoFilter
'Writes headers
.Range("A4:S4").Value2 = ShHead2
'Sets width of columns for differnet columns
.Columns("A").ColumnWidth = 10
.Columns("B").ColumnWidth = 25
.Columns("C").ColumnWidth = 30
.Columns("D:E").ColumnWidth = 4
.Columns("F").ColumnWidth = 10
.Columns("G:I").ColumnWidth = 2
.Columns("J").ColumnWidth = 8
.Columns("K").ColumnWidth = 5.5
.Columns("L").ColumnWidth = 35
.Columns("M").ColumnWidth = 3
.Columns("N:O").ColumnWidth = 6
.Columns("P").ColumnWidth = 20
.Columns("Q").ColumnWidth = 20
.Columns("R").ColumnWidth = 5
.Columns("S").ColumnWidth = 40
'Wraps text in column
.Columns("L").WrapText = True
.Columns("S").WrapText = True
'Sets formats for columns containing numbers
.Columns("A").NumberFormat = "#"
.Columns("D:E").NumberFormat = "#"
.Columns("F").NumberFormat = "m/d/yyyy"
.Columns("J").NumberFormat = "### ### ###"
.Range("G:G").HorizontalAlignment = xlCenter
.Range("Q:Q").HorizontalAlignment = xlLeft
'Sets height for all rows
.Rows("1:1048576").RowHeight = 15
End With
'Goes to sheet and cell
Application.Goto ThisWorkbook.Sheets("Result").Range("A5")
'Freezes panes
ActiveWindow.FreezePanes = False
'Freezes panes
ActiveWindow.FreezePanes = True
Application.StatusBar = "Sheet /Result/ formated!"
'Formating sheet "NoResult"
With ThisWorkbook.Sheets("NoResult")
'Clears whole sheet
.UsedRange.Clear
'Text in first row set to bold
.Range("A4:S4").Font.Bold = True
'Creates filter
.Range("A4:S4").AutoFilter
'Writes headers
.Range("A4:S4").Value = ShHead2
'Sets width of columns for differnet columns
.Columns("A").ColumnWidth = 10
.Columns("B").ColumnWidth = 25
.Columns("C").ColumnWidth = 30
.Columns("D:E").ColumnWidth = 4
.Columns("F").ColumnWidth = 10
.Columns("G:I").ColumnWidth = 2
.Columns("J").ColumnWidth = 8
.Columns("K").ColumnWidth = 5.5
.Columns("L").ColumnWidth = 35
.Columns("M").ColumnWidth = 3
.Columns("N:O").ColumnWidth = 6
.Columns("P").ColumnWidth = 20
.Columns("Q").ColumnWidth = 20
.Columns("R").ColumnWidth = 5
.Columns("S").ColumnWidth = 40
'Wraps text in column
.Columns("L").WrapText = True
.Columns("S").WrapText = True
'Sets formats for columns containing numbers
.Columns("A").NumberFormat = "#"
.Columns("D:E").NumberFormat = "#"
.Columns("F").NumberFormat = "m/d/yyyy"
.Columns("J").NumberFormat = "### ### ###"
.Range("G:G").HorizontalAlignment = xlCenter
.Range("Q:Q").HorizontalAlignment = xlLeft
'Sets height for all rows
.Rows("1:1048576").RowHeight = 15
End With
'Goes to sheet and cell
Application.Goto ThisWorkbook.Sheets("NoResult").Range("A5")
'Freezes panes
ActiveWindow.FreezePanes = False
'Freezes panes
ActiveWindow.FreezePanes = True
Application.StatusBar = "Sheet /NoResult/ formated!"
'====================
'Procedure that adds finishing touches at end of procedure
Call EndProcedure
'====================
End Sub
The following code I have Will paste a value code of "01" to a cell and then skip 4 rows continuously, until reaching the end of count within the for loop. I want to run a similar loop for "02", but rather than "Step" (skip) 4 rows, I would like it to insert the value in 6 consecutive rows within the same column and then skip 3 rows continuously until reaching the end of count. I am 2 weeks new to vba, so I hope I am explaining this correctly.
Dim i As Long
If Sheet3.Range("C22").Value = "01" Then
For i = 3 To 202 Step 4
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = _
ActiveWorkbook.Sheets("MonData").Cells(22, 5).Value
Next i
ElseIf Sheet3.Range("C22").Value = "02" Then
For i = 3 To 152
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = _
ActiveWorkbook.Sheets("MonData").Cells(22, 5).Value
Next i
End If
Maybe like this:
Dim i As Long, v
v = ActiveWorkbook.Sheets("MonData").Cells(22, 5).Value
If Sheet3.Range("C22").Value = "01" Then
For i = 3 To 202 Step 4
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = v
Next i
ElseIf Sheet3.Range("C22").Value = "02" Then
For i = 3 To 152 Step 9 '6 filled + 3 empty = 9
ActiveWorkbook.Sheets("CrewEntries").Cells(i, 6).Value = v
Next i
End If
For such a kind of question, I would advise a while-loop, as in this piece of pseudo-code:
dim condition as boolean
dim loop_step, interesting_value as integer
condition = true
loop_step = 1 'just in order to be sure that it never is 0, this might create an infinite loop
interesting_value = 0 ' or some other initialisation value
while condition do
if <some_first_condition>
then
do_first_thing(interesting_value, ...)
loop_step = 3
else
do_second_thing(interesting_value, ...)
loop_step = 6
end if
interesting_value = interesting_value + loop_step
if <some_other_condition> then condition = false
Wend
Sub EarningCode()
Dim CpID As String
Dim i As Long
Dim p As Long
CpID = ActiveWorkbook.Sheets("MonData").Cells(22, 3).Value
For i = 3 To 452
If p = 9 Then
p = 1
Else
p = p + 1
End If
If p < 7 Then
ThisWorkbook.Worksheets("CrewEntries").Cells(i, 4).Value = "02"
End If
Next i
End Sub
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
What I want this part of the code to do is if the value of cell H83 is greater than 22 then I want the code to increase the value of cell R14 which is 0.7 by an increment of 0.01 until either R14 reaches 0.75 or until H83 is less than 22. I have tried:
For j = 0.69 To 0.74
w = j + 0.01
If Range("h83") > 22 Then
Range("r14").Value = w
If 21 < Range("h83") < 23 Then Exit For
End If
Next j
This doesn't work and right now I have it so it increases it by 0.01 only once (part in asterisks), full code:
Sub C_CreateTestResultTableV2()
Application.ScreenUpdating = True 'helps the code run faster
Dim vInputs, vResults()
Dim c As Integer, i As Integer
'create INPUTS
c = Range("b5").End(xlToRight).Column
vInputs = Range("b5", Cells(9, c))
'determine last value in the column
c = UBound(vInputs, 2)
'create RESULTS
ReDim vResults(1 To 4, 1 To c)
For i = 1 To c
'checks to see if t_air_in > 22
If vInputs(1, i) > 22 And vInputs(3, i) < 70 Then
'set values
Range("j18") = vInputs(1, i)
Range("n14") = vInputs(3, i)
Range("r16") = vInputs(5, i)
'checks to see if t_air_out = 22 and changes t_wat_in and m_wat_in accordingly
If Range("h83") > 22 Then
Range("r16").Value = Range("r16").Value - 3
End If
*If Range("h83") > 22 Then
Range("r14").Value = Range("r14").Value + 0.01
End If*
'copy output values into RESULTS
vResults(1, i) = Range("h83")
vResults(2, i) = Range("k83")
vResults(3, i) = Range("z14")
vResults(4, i) = Range("r15")
End If
'resets values
Range("r16").Value = 13
Range("r14").Value = 0.7
Next i
Range("b96").Resize(4, c) = vResults
Application.ScreenUpdating = True
End Sub
If you want something to happen until a certain condition is met, but you don't know exactly when that happens, you need a Do-Loop:
Do While Range("H83").Value < 23
Range("R14").Value = Range("R14").value + 0.01
Range("H83").value = Range("H83").value + x 'If you don't do something with Range("H83"), the loop will go on forever
Loop
Edit: From someone who made this mistake more than willing to admit: If you create a do-loop, please make sure that you don't create an infinite loop, because the chance is high that VBA won't respond anymore.
I would like to ask help to sum all items under a merged cell.
Item looks like this:
June
0 1 2 3 4 5 6 7 8 9
2 3 4 5 6 7 8 9 0 1
June is a merged cell, and I want to sum all items under it.
Is this even possible?
This will work whether the cells are merged or un-merged. Say we have merged A1 through C2 with contents like:
The following UDF() will give the sum of the numeric values:
Public Function InternalSum(rin As Range) As Double
Dim v As String, CH As String, temp As String
Dim dot As String, L As Long, i As Long
Dim capture As Boolean
v = rin(1).Text
InternalSum = 0
dot = "."
temp = ""
capture = False
L = Len(v)
If L = 0 Then Exit Function
For i = 1 To L
CH = Mid(v, i, 1)
If IsNumeric(CH) Or CH = dot Then
capture = True
temp = temp & CH
If i = L Then
InternalSum = InternalSum + CDbl(temp)
End If
Else
If capture Then
capture = False
InternalSum = InternalSum + CDbl(temp)
temp = ""
End If
End If
Next i
End Function
Note that both:
=internalsum(A1)
and
=internalsum(A1:C2)
will work.