I've written the following macro to insert a specified number of rows into a table, and then to filldown, to re-populate the table with the correct forumulas.
I don't know why this is failing with an error at ActiveSheet.Rows(r).Insert with runtime error 1004. Insert method of Range class failed.
Could you help me out?
Sub SetKPIDuration()
Dim Duration As Integer, i As Integer, r As Integer
Duration = InputBox("Enter number of week for KPI to run (min 18)",
"Duration of KPI", 18)
Select Case True
Case Duration < 10
Duration = 18
GoTo IncreaseKPI
Case Duration < Application.WorksheetFunction.Max(Range("A7:A150"))
GoTo ReduceKPI
Case Else
GoTo IncreaseKPI
End Select
ReduceKPI:
Rows((Duration + 7) & ":150").Clear
Exit Sub
IncreaseKPI:
Application.ScreenUpdating = False
i = Application.WorksheetFunction.Max(Range("A7:A150"))
r = i + 7
While i < Duration
ActiveSheet.Rows(r).insert
Wend
Range("A" & (r - 1) & ":" & "M" & (r + i)).filldown
Application.CutCopyMode = False
ScreenUpdating = True
End Sub
Try fully qualifying your ranges with full workbooks.worksheets.range paths.
It looks like your line below might not be returning the result you want:
i = Application.WorksheetFunction.Max(Range("A7:A150"))
if i is less than 18, you'll get an infinite loop here:
While i < Duration
ActiveSheet.Rows(r).insert
Wend
...which eventually results in your 1004 error
Related
I want to automate a calculation for a measurement data Excel file.
While I made the function work, I could only figure out how to do that for one row at a time. The calculation is specific to the data on every row.
I thought I could change the Range("J3") value to Range("J3:J52") for a capacity of 50 calculations.
How do I make the function calculate for every row, separately, using the data of said specific row?
It doesn't matter if it runs for all 50 rows or if I have to figure out some loop function to find how many rows to calculate for, as long as one button press in the end will make the magic happen.
I have included a screenshot of the sheet for reference, the main calculation is done in Excel, but what this is doing is choosing the correct option out of a few different correction calculations and explaining to the user why.
I think there are some unnecessary Dim lines at the start but if it runs, I wasn't going to remove them.
'The main function, activated by a simple button Sub'
Function ISO16032()
'DeltaL Range'
Dim DeltaL As Range
Set DeltaL = Range("F3")
'Result is the corrected value in G column'
Dim Result As Long
'Note is the calc note in H column'
Dim Note As String
'X is the DeltaL between noise and background noise'
Dim x As Long
x = Range("F3").Value
Select Case Range("F3").Value
'No correction when X = > 10'
Case 10.6 To 200
Result = Range("J3")
Range("G3").Value = Result
Note = "No correction"
Range("H3").Value = Note
'Correction according to ISO16032 when X = between 4 and 10'
Case 3.6 To 10.5
Result = Range("K3")
Range("G3").Value = Result
Note = "Correction per ISO16032"
Range("H3").Value = Note
'Maximal correction value set to 2,2 dB if X < 4'
Case 0.1 To 3.5
Result = Range("L3")
Range("G3").Value = Result
Note = "Correction limit set to 2,2 dB"
Range("H3").Value = Note
'If x = < 0, the measurement is invalid'
Case Else
Note = "Repeat measurement!"
Range("H3").Value = Note
End Select
End Function
Hi and welcome to stackoverflow, I think that a simple loop, with the addition of an argument to your ISO function allows you to solve your problem like this
Sub Looping()
For i = 3 To 52
' Convert i to String because we need to concatenate with the letter F, G, H...
Call ISO16032(CStr(i))
Next
End Sub
Function ISO16032(Cell_X)
'DeltaL Range'
Dim DeltaL As Range
Set DeltaL = Range("F" + Cell_X)
'Result is the corrected value in G column'
Dim Result As Long
'Note is the calc note in H column'
Dim Note As String
'X is the DeltaL between noise and background noise'
Dim x As Long
x = Range("F" + Cell_X).Value
Select Case Range("F" + Cell_X).Value
'No correction when X = > 10'
Case 10.6 To 200
Result = Range("J" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "No correction"
Range("H" + Cell_X).Value = Note
'Correction according to ISO16032 when X = between 4 and 10'
Case 3.6 To 10.5
Result = Range("K" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "Correction per ISO16032"
Range("H" + Cell_X).Value = Note
'Maximal correction value set to 2,2 dB if X < 4'
Case 0.1 To 3.5
Result = Range("L" + Cell_X)
Range("G" + Cell_X).Value = Result
Note = "Correction limit set to 2,2 dB"
Range("H" + Cell_X).Value = Note
'If x = < 0, the measurement is invalid'
Case Else
Note = "Repeat measurement!"
Range("H" + Cell_X).Value = Note
End Select
End Function
EDIT: think indented your code like I did to make it more readable too (or like #Darren Bartrup-Cook did when editing your question)
This is more of an example of how to calculate each row.
Just getting your code to work across multiple rows.
Cells
With...End With Statement
'No need for Sub to call function that doesn't return anything.... just write a sub.
Public Sub ISO16032()
Dim LastRow As Long
With ThisWorkbook.Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, 10).End(xlUp).Row
Dim RowCounter As Long
Dim Result As Long
Dim Note As String
'Only calculate if there is data in rows 3 onwards.
If LastRow >= 3 Then
'Reset results on each pass.
'Assuming -1 is an impossible answer so code knows
'not to put anything on Case Else.
Result = -1
Note = ""
'Cycle through each row and calculate.
For RowCounter = 3 To LastRow
Select Case .Cells(RowCounter, 6) 'Look at column F(column 6) on each row.
Case 10.6 To 200
Result = .Cells(RowCounter, 10)
Note = "No corrections."
Case 3.6 To 10.5
Result = .Cells(RowCounter, 11)
Note = "Correction per ISO16032"
Case 0.1 To 3.5
Result = .Cells(RowCounter, 12)
Note = "Correction limit set to 2,2 dB"
Case Else
Note = "Repeat measurement!"
End Select
'Place results on sheet.
.Cells(RowCounter, 7) = IIf(Result >= 0, Result, "")
.Cells(RowCounter, 8) = Note
Next RowCounter
End If
End With
End Sub
I'm new here but hope you all can help with a solution I'm working towards. I'm working on an excel document and setting up a macro. It works until I try to add some logic to pad a number with zero's.
I'm trying to pad zero's in a select cell where the labels are less than 10, then add my integer. If the labels are greater than 9, I want to pad one less zero, likewise when they are greater than 99, one less from those with 10 or more.
My program asks the user how many labels they wish to print (1-999).
I've tried to add an IF statement within my For I = 1 To LabelCount:
For I = 1 To LabelCount
If I < 10 Then
ActiveSheet.Range("C20").Value = "C906BGM0880000" & I
ActiveSheet.PrintPreview
Else
ActiveSheet.Range("C20").Value = "C906BGM088000T" & I
ActiveSheet.PrintPreview
End If
Next
The above did not work.
Sub IncrementPrint()
'updateby Tyler Garretson
Dim LabelCount As Variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
LInput:
LabelCount = Application.InputBox("Please enter the number of copies you want to print:")
If TypeName(LabelCount) = "Boolean" Then Exit Sub
If (ActiveSheet.Range("F11").Value = "") Or (ActiveSheet.Range("F14").Value = "") Or (ActiveSheet.Range("C18").Value = "") Then
MsgBox "Error Occurred. Please enter values for Route, Stop, and Destination Name", vbExclamation
ElseIf (LabelCount = "") Or (Not IsNumeric(LabelCount)) Or (LabelCount < 1) Or (LabelCount > 999) Then
MsgBox "Error Occurred. Please enter 1 - 999", vbExclamation
ElseIf LabelCount < 10 Then
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To LabelCount
ActiveSheet.Range("C20").Value = "C906BGM0880000" & I
ActiveSheet.PrintPreview
Next
ActiveSheet.Range("C20").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub
User enters 11 labels that he or she wishes to print, the program prints out the following:
Label1: ABC00001
Label2: ABC00002
Label3: ABC00003
Label4: ABC00004
Label5: ABC00005
Label6: ABC00006
Label7: ABC00007
Label8: ABC00008
Label9: ABC00009
Label10: ABC00010
Label11: ABC00011
You want the Format command - Format(1, "00000") = 00001
Format(123,"00000") = 00123
' This might be the basis of what you need
for a = 1 to 1000
b = right("0000000000" & a,8) ' B will always be 8 long and paaded left with 0's
next a
This works well with a text prefix too
for a = 1 to 1000
c = "XYZ" & right("0000000000" & a,8)
next a
I have a code that searches an excel fill for the word distance, takes the value of the cell next to it, paste it into a new cell, then sums all the cells up. Which works great, but i now need to find a way to only sum ever even row number. Does that make sense?
Sub Distance_Check()
Dim DistanceCheck As String
Dim DistanceNumber As String
Dim DistanceSum As String
Dim DistanceTotal As String
DistanceCheck = MsgBox("Would you like to check the distance?", vbYesNo)
If DistanceCheck = vbYes Then
If IsArray(fname) Then Workbooks.OpenText fname(1)
i = 1
findStr = "Distance"
Set foundCel = Range("A:A").Find(what:=findStr)
If Not foundCel Is Nothing Then
firstAddress = foundCel.Address
Do
Range("J" & i).Value = foundCel.Offset(0, 1).Value
Set foundCel = Range("A:A").FindNext(foundCel)
i = i + 1
Loop While Not foundCel Is Nothing And foundCel.Address <> firstAddress
End If
Set wkbSourceBook = ActiveWorkbook
DistanceNumber = i - 2
DistanceSum = WorksheetFunction.Sum(Range(Cells(2, 15), (Cells(DistanceNumber + 1, 15))))
DistanceTotal = DistanceSum / DistanceNumber
If DistanceNumber = Cells(2, 12) Then
MsgBox ("No error found wihin distance")
Else
MsgBox ("Error found with distance")
End If
Else
End If
Call Save_Data
End Sub
Would the way youd go about this be using a for loop on the
cells(DistanceNumber(j,+1)
Where j = 0,
j = j +2 ,
Until j > DistanceNumber,
Would that work? If so how would you go about it?
Thanks
A quick way to step through a loop in the desired increments is to use the Mod operator which divides two numbers and returns any remainder (e.g. 7 mod 2 = 1, as two sixes fit into seven, leaving one).
You can use the row property of the range you identify with the Find method, and since you want to jump by two the modulo should be zero:
If foundcel.Row Mod 2 = 0 Then Range("J" & i).value = foundcel.Offset(0, 1).Value
That said, there is a 'built in' way to step through a loop if using a For loop like this
For x = 2 to 10 Step 2
' Do stuff
Next x
You can also use this method to step backwards, e.g.
For x = 100 to 0 Step -10
' Do stuff backwards!
Next x
I have a large table, sometimes with hundreds of rows.
This table is generated by another application that exports to excel.
One column has the heading "Adjusted Price".
I want all the rows in this column to contain a formula (presently they're all 0's).
I want to automate this process because the table gets regenerated all the time.
This column may not always be in the same place. So I need a macro that can find this column ("Adjusted Price") and then fill all the cells in that column with a formula (with the exception of the first row of course).
Can this be done?
Thanks in advance :)
Your homework is to figure out how to plug it in!
Option Explicit
Sub setAdjustedPrice()
Dim column As Integer
Dim adjustedPriceColumn As String
Dim found As Boolean
Dim rowCount As Long
column = 1
rowCount = 1
Do While Range(FncAlphaCon(column) & rowCount).Value <> "" And found = False
If (Range(FncAlphaCon(column) & rowCount).Value = "Adjusted Price") Then
found = True
adjustedPriceColumn = FncAlphaCon(column)
Else
column = column + 1
End If
Loop
If found = True Then
Do While rowCount < ActiveSheet.UsedRange.Rows.count
rowCount = rowCount + 1
Range(adjustedPriceColumn & rowCount) = "YOUR FORMULA"
Loop
Else
MsgBox ("'Adjusted Price' column not found, cannot continue.")
End If
End Sub
Private Function FncAlphaCon(aNumber As Integer) As String
' Fixed version 27/10/2011
Dim letterArray As String
Dim iterations As Integer
letterArray = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If aNumber <= 26 Then
FncAlphaCon = (Mid$(letterArray, aNumber, 1))
Else
If aNumber Mod 26 = 0 Then
iterations = Int(aNumber / 26)
FncAlphaCon = (Mid$(letterArray, iterations - 1, 1)) & (Mid$(letterArray, 26, 1))
Else
'we deliberately round down using 'Int' as anything with decimal places is not a full iteration.
iterations = Int(aNumber / 26)
FncAlphaCon = (Mid$(letterArray, iterations, 1)) & (Mid$(letterArray, (aNumber - (26 * iterations)), 1))
End If
End If
End Function
I have some vba code to grab information 4 times a minute from a device on it's web configuration page.
I need this to happen from when I place an x in column C and continue until I place an x in column D further down the page.
I have a function I can call which will tell if an X is in the proper place in d, relative to c.
What I'd like to do is have a button which says ok, be ready to scan. then have it start when the first value is entered in c, then stop when the d value is entered.
I'm also having trouble coming up with a way to enter values while the VBA script is actually running.
Any advice? Thanks.
Here is the code to check the columns.
Public Function BackgroundScan(MonitorSpreadsheet As Boolean) As Boolean
Dim LastStart As Integer
Dim LastStop As Integer
intDebug = 1
Select Case MonitorSpreadsheet
Case True
'We are actively testing
If intDebug = 1 Then MsgBox "we ARE monitoring the spreadsheet."
'Call scanning routine here
'Get the status TestingInProgress
LastStart = FindLastStartRow("SVQ")
LastStop = FindLastStopRow("SVQ")
If intDebug = 1 Then MsgBox "LastStart " & LastStart
If intDebug = 1 Then MsgBox "LastStop " & LastStop
Select Case LastStart
Case Is < 20
'We have not started.
If intDebug = 1 Then MsgBox "We have not started."
BackgroundScan = False
'Loop around, and check again
Case Else
'ok we have started, now check to see if we have stopped.
Select Case LastStop
Case Is < LastStart
'**** We ARE testing!!! ****
If intDebug = 1 Then MsgBox "We are testing, and haven't finished."
BackgroundScan = True
Case LastStart
'LastStart and LastStop are the same line, we have started AND finished
If intDebug = 1 Then MsgBox "We have started AND finished!"
BackgroundScan = False
'Loop around, and check again
Case Else
'We have finished testing, and the test spanned multiple rows
BackgroundScan = False
If intDebug = 1 Then MsgBox "We started on one line, and finished on another."
End Select
End Select
Case False
'we are not actively testing
If intDebug = 1 Then MsgBox "We are NOT monitoring the spreadsheet."
BackgroundScan = False
Case Else
MsgBox "Error: Boolean variable reports: " & MonitorSpreadsheet
BackgroundScan = False
End Select
End Function
Here is the code which scans the webpage.
Private Sub CommandButton1_Click()
Dim Some As String 'can't resist a good pun!
Dim intDelay As Integer
Dim intMinDelay As Integer
Dim i As Integer
Dim s As Integer
Dim RunStart As Date
Dim WhichSVBeam As String
Dim lLen As Integer
Dim CurrentSVID As String
Dim CurrentBeamID As String
Dim PreviousSVID As String
Dim PreviousBeamID As String
Dim ColonLocation As Integer
'*******************************************************
'*** Test Continuous Button ***
'*** Where n is specified in cell A6 ***
'*******************************************************
'grab the number of minutes between checking values
intMinDelay = GetValues("A7")
RunStart = Now
'Do this until the end of time, or the execution is halted.
Do 'uncomment do when we are sure the DoEvents will work as we expect
WhichSVBeam = Scan_SVBeam(PreviousSVID, PreviousBeamID)
If InStr(WhichSVBeam, ":") Then
lLen = Len(WhichSVBeam)
ColonLocation = InStr(WhichSVBeam, ":")
'MsgBox WhichSVBeam & ", " & ColonLocation
CurrentSVID = Left(WhichSVBeam, ColonLocation - 1)
'MsgBox CurrentSVID
CurrentBeamID = Right(WhichSVBeam, lLen - ColonLocation)
'MsgBox CurrentBeamID
Else
'no colon, nothing to parse (this shouldn't happen)
MsgBox "No ':' from Scan_SVBeam"
End If
'Call sCheckExecutionTimeGap(RunStart)
'loop for the number of minutes we specified
For i = 1 To intMinDelay
'check every second for events
For s = 1 To 240
Call AppSleep(250)
DoEvents
Next s
Next i
Loop
End Sub
A example of a piece of code that will run at regular intervals, and allows you to change values in your spreadsheet that will be checked, is the following:
Sub testCell()
Dim r1, r2 As Integer
Dim stopIt As Boolean
r1 = doWeStart
r2 = doWeStop(r1)
Debug.Print "The value of cell C1 is now " & [C1].Value
If r1 = 0 Then Debug.Print "We haven't started yet"
If r1 > 0 And r2 = 0 Then Debug.Print "We start but don't stop"
If r1 > 0 And r2 > 0 Then Debug.Print "We started and stopped"
If [C1].Value Like "stop" Or r1 > 0 And r2 > 0 Then stopIt = True Else stopIt = False
If Not stopIt Then
Application.OnTime Now + TimeValue("00:00:05"), "testCell"
End If
End Sub
'
Function doWeStart()
Dim xrow As Integer
' save old selection
Set r = Selection
xrow = 0
' search for "x" in column C
On Error Resume Next
xrow = Application.WorksheetFunction.Match("x", [C:C], 0)
doWeStart = xrow
End Function
'
Function doWeStop(r1)
Dim xrowd As Integer
xrowd = 0
' search for "x" in column D, starting at row r1
On Error Resume Next
xrowd = Application.WorksheetFunction.Match("x", Range("D" & r1, "D1048576"), 0)
If xrowd > 0 Then
doWeStop = xrowd + r1 - 1
Else
doWeStop = 0
End If
End Function
This will run every five seconds, will look for the first "x" in column C and the first "x" in column D below the one found in C. Depending on what is there, it will (for now) print a message in the debug window - you can put your code there. When you enter "stop" in C1, or an "x" is found in both C and D, it stops.
in pseudo code it would be something along th lines of:
start when column c=x
begin loop
get data
check value of column d
if column d= x exit loop
next loop iteration
end
is that what you want?
Philip