How can I run a vba I wrote against all of the rows of my excel sheet?
I have following script. I need to run it against 27,000 rows in excel.
The output should be dropped into column DG at the end of every row. It should be crunching the values in the cells between columns C and DF (108 cells).
Function binning()
Dim rng As Range
Dim str, binStat, temp As String
Dim passes As Integer
Set passes = 0
Set rng = Application.Selection
Set binStat = "High"
For Each cell In rng
temp = cell.Value
Select Case temp
Case "Passed"
passes = passes + 1
If passes = 2 Then
If binStat = "High" Then
binStat = "Medium"
passes = 0
ElseIf binStat = "Medium" Then
binStat = "Low"
passes = 0
ElseIf binStat = "Low" Then
passes = 0
End If
End IF
Case "Failed"
passes = 0
If binStat = "High" Then
binStat = "High"
ElseIf binStat = "Medium" Then
binStat = "High"
ElseIf binStat = "Low" Then
binStat = "Medium"
End If
End Select
Next cell
binning = binStat
End Function
So basically it should be running across each row between C and DF and in DG setting the value as High, Medium, or Low based on the script. Starts on row 2 of the sheet.
Trouble is - I am have no idea how to make that happen in excel 2007.
excel vba excel-vba excel-2007
add a comment |
I have following script. I need to run it against 27,000 rows in excel.
The output should be dropped into column DG at the end of every row. It should be crunching the values in the cells between columns C and DF (108 cells).
Function binning()
Dim rng As Range
Dim str, binStat, temp As String
Dim passes As Integer
Set passes = 0
Set rng = Application.Selection
Set binStat = "High"
For Each cell In rng
temp = cell.Value
Select Case temp
Case "Passed"
passes = passes + 1
If passes = 2 Then
If binStat = "High" Then
binStat = "Medium"
passes = 0
ElseIf binStat = "Medium" Then
binStat = "Low"
passes = 0
ElseIf binStat = "Low" Then
passes = 0
End If
End IF
Case "Failed"
passes = 0
If binStat = "High" Then
binStat = "High"
ElseIf binStat = "Medium" Then
binStat = "High"
ElseIf binStat = "Low" Then
binStat = "Medium"
End If
End Select
Next cell
binning = binStat
End Function
So basically it should be running across each row between C and DF and in DG setting the value as High, Medium, or Low based on the script. Starts on row 2 of the sheet.
Trouble is - I am have no idea how to make that happen in excel 2007.
excel vba excel-vba excel-2007
@Comintern you're correct I apologize. VBA. Not script. Sorry new enough at VB that I did not initially know there were differences and I needed specifics.
– Adam
Nov 12 at 15:10
1
Do you want it to run over 27,000 rows or on 250ish columns fromC
toDF
?
– FreeMan
Nov 12 at 15:12
@FreeMan Place result in DG when run against the values C:DF
– Adam
Nov 12 at 15:14
add a comment |
I have following script. I need to run it against 27,000 rows in excel.
The output should be dropped into column DG at the end of every row. It should be crunching the values in the cells between columns C and DF (108 cells).
Function binning()
Dim rng As Range
Dim str, binStat, temp As String
Dim passes As Integer
Set passes = 0
Set rng = Application.Selection
Set binStat = "High"
For Each cell In rng
temp = cell.Value
Select Case temp
Case "Passed"
passes = passes + 1
If passes = 2 Then
If binStat = "High" Then
binStat = "Medium"
passes = 0
ElseIf binStat = "Medium" Then
binStat = "Low"
passes = 0
ElseIf binStat = "Low" Then
passes = 0
End If
End IF
Case "Failed"
passes = 0
If binStat = "High" Then
binStat = "High"
ElseIf binStat = "Medium" Then
binStat = "High"
ElseIf binStat = "Low" Then
binStat = "Medium"
End If
End Select
Next cell
binning = binStat
End Function
So basically it should be running across each row between C and DF and in DG setting the value as High, Medium, or Low based on the script. Starts on row 2 of the sheet.
Trouble is - I am have no idea how to make that happen in excel 2007.
excel vba excel-vba excel-2007
I have following script. I need to run it against 27,000 rows in excel.
The output should be dropped into column DG at the end of every row. It should be crunching the values in the cells between columns C and DF (108 cells).
Function binning()
Dim rng As Range
Dim str, binStat, temp As String
Dim passes As Integer
Set passes = 0
Set rng = Application.Selection
Set binStat = "High"
For Each cell In rng
temp = cell.Value
Select Case temp
Case "Passed"
passes = passes + 1
If passes = 2 Then
If binStat = "High" Then
binStat = "Medium"
passes = 0
ElseIf binStat = "Medium" Then
binStat = "Low"
passes = 0
ElseIf binStat = "Low" Then
passes = 0
End If
End IF
Case "Failed"
passes = 0
If binStat = "High" Then
binStat = "High"
ElseIf binStat = "Medium" Then
binStat = "High"
ElseIf binStat = "Low" Then
binStat = "Medium"
End If
End Select
Next cell
binning = binStat
End Function
So basically it should be running across each row between C and DF and in DG setting the value as High, Medium, or Low based on the script. Starts on row 2 of the sheet.
Trouble is - I am have no idea how to make that happen in excel 2007.
excel vba excel-vba excel-2007
excel vba excel-vba excel-2007
edited Nov 12 at 15:11
asked Nov 12 at 15:04
Adam
366
366
@Comintern you're correct I apologize. VBA. Not script. Sorry new enough at VB that I did not initially know there were differences and I needed specifics.
– Adam
Nov 12 at 15:10
1
Do you want it to run over 27,000 rows or on 250ish columns fromC
toDF
?
– FreeMan
Nov 12 at 15:12
@FreeMan Place result in DG when run against the values C:DF
– Adam
Nov 12 at 15:14
add a comment |
@Comintern you're correct I apologize. VBA. Not script. Sorry new enough at VB that I did not initially know there were differences and I needed specifics.
– Adam
Nov 12 at 15:10
1
Do you want it to run over 27,000 rows or on 250ish columns fromC
toDF
?
– FreeMan
Nov 12 at 15:12
@FreeMan Place result in DG when run against the values C:DF
– Adam
Nov 12 at 15:14
@Comintern you're correct I apologize. VBA. Not script. Sorry new enough at VB that I did not initially know there were differences and I needed specifics.
– Adam
Nov 12 at 15:10
@Comintern you're correct I apologize. VBA. Not script. Sorry new enough at VB that I did not initially know there were differences and I needed specifics.
– Adam
Nov 12 at 15:10
1
1
Do you want it to run over 27,000 rows or on 250ish columns from
C
to DF
?– FreeMan
Nov 12 at 15:12
Do you want it to run over 27,000 rows or on 250ish columns from
C
to DF
?– FreeMan
Nov 12 at 15:12
@FreeMan Place result in DG when run against the values C:DF
– Adam
Nov 12 at 15:14
@FreeMan Place result in DG when run against the values C:DF
– Adam
Nov 12 at 15:14
add a comment |
1 Answer
1
active
oldest
votes
Maybe something like this (uses sub rather than function):
Option Explicit
Sub AssignRowValuesToBins()
' Change to whatever your sheet is called. I assume Sheet1.
With ThisWorkbook.Worksheets("Sheet1")
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Dim arrayOfValues() As Variant
arrayOfValues = .Range("C2:DG" & lastRow).Value2
Dim rowIndex As Long
Dim columnIndex As Long
Dim binStat As String
Dim passCount As Long
Dim writeColumnIndex As Long
writeColumnIndex = UBound(arrayOfValues, 2)
For rowIndex = LBound(arrayOfValues, 1) To UBound(arrayOfValues, 1)
binStat = "High"
passCount = 0
For columnIndex = LBound(arrayOfValues, 2) To (writeColumnIndex - 1)
If AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Passed") Then
passCount = passCount + 1
If passCount = 2 Then
If AreStringsIdentical(binStat, "High") Then
binStat = "Medium"
passCount = 0
ElseIf AreStringsIdentical(binStat, "Medium") Then
binStat = "Low"
passCount = 0
ElseIf AreStringsIdentical(binStat, "Low") Then
passCount = 0
End If
End If
ElseIf AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Failed") Then
passCount = 0
If AreStringsIdentical(binStat, "High") Then
binStat = "High"
ElseIf AreStringsIdentical(binStat, "Medium") Then
binStat = "High"
ElseIf AreStringsIdentical(binStat, "Low") Then
binStat = "Medium"
End If
Else
arrayOfValues(rowIndex, writeColumnIndex) = "Unexpected value '" & arrayOfValues(rowIndex, columnIndex) & "'"
End If
Next columnIndex
arrayOfValues(rowIndex, writeColumnIndex) = binStat
Next rowIndex
.Range("C2").Resize(UBound(arrayOfValues, 1), UBound(arrayOfValues, 2)).Value2 = arrayOfValues
End With
End Sub
Private Function AreStringsIdentical(ByVal firstString As String, ByVal secondString As String) As Boolean
' Performs case-sensitive comparison.
AreStringsIdentical = (VBA.Strings.StrComp(firstString, secondString, vbBinaryCompare) = 0)
End Function
add a comment |
Your Answer
StackExchange.ifUsing("editor", function () {
StackExchange.using("externalEditor", function () {
StackExchange.using("snippets", function () {
StackExchange.snippets.init();
});
});
}, "code-snippets");
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "1"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53264904%2fhow-can-i-run-a-vba-i-wrote-against-all-of-the-rows-of-my-excel-sheet%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
1 Answer
1
active
oldest
votes
1 Answer
1
active
oldest
votes
active
oldest
votes
active
oldest
votes
Maybe something like this (uses sub rather than function):
Option Explicit
Sub AssignRowValuesToBins()
' Change to whatever your sheet is called. I assume Sheet1.
With ThisWorkbook.Worksheets("Sheet1")
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Dim arrayOfValues() As Variant
arrayOfValues = .Range("C2:DG" & lastRow).Value2
Dim rowIndex As Long
Dim columnIndex As Long
Dim binStat As String
Dim passCount As Long
Dim writeColumnIndex As Long
writeColumnIndex = UBound(arrayOfValues, 2)
For rowIndex = LBound(arrayOfValues, 1) To UBound(arrayOfValues, 1)
binStat = "High"
passCount = 0
For columnIndex = LBound(arrayOfValues, 2) To (writeColumnIndex - 1)
If AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Passed") Then
passCount = passCount + 1
If passCount = 2 Then
If AreStringsIdentical(binStat, "High") Then
binStat = "Medium"
passCount = 0
ElseIf AreStringsIdentical(binStat, "Medium") Then
binStat = "Low"
passCount = 0
ElseIf AreStringsIdentical(binStat, "Low") Then
passCount = 0
End If
End If
ElseIf AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Failed") Then
passCount = 0
If AreStringsIdentical(binStat, "High") Then
binStat = "High"
ElseIf AreStringsIdentical(binStat, "Medium") Then
binStat = "High"
ElseIf AreStringsIdentical(binStat, "Low") Then
binStat = "Medium"
End If
Else
arrayOfValues(rowIndex, writeColumnIndex) = "Unexpected value '" & arrayOfValues(rowIndex, columnIndex) & "'"
End If
Next columnIndex
arrayOfValues(rowIndex, writeColumnIndex) = binStat
Next rowIndex
.Range("C2").Resize(UBound(arrayOfValues, 1), UBound(arrayOfValues, 2)).Value2 = arrayOfValues
End With
End Sub
Private Function AreStringsIdentical(ByVal firstString As String, ByVal secondString As String) As Boolean
' Performs case-sensitive comparison.
AreStringsIdentical = (VBA.Strings.StrComp(firstString, secondString, vbBinaryCompare) = 0)
End Function
add a comment |
Maybe something like this (uses sub rather than function):
Option Explicit
Sub AssignRowValuesToBins()
' Change to whatever your sheet is called. I assume Sheet1.
With ThisWorkbook.Worksheets("Sheet1")
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Dim arrayOfValues() As Variant
arrayOfValues = .Range("C2:DG" & lastRow).Value2
Dim rowIndex As Long
Dim columnIndex As Long
Dim binStat As String
Dim passCount As Long
Dim writeColumnIndex As Long
writeColumnIndex = UBound(arrayOfValues, 2)
For rowIndex = LBound(arrayOfValues, 1) To UBound(arrayOfValues, 1)
binStat = "High"
passCount = 0
For columnIndex = LBound(arrayOfValues, 2) To (writeColumnIndex - 1)
If AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Passed") Then
passCount = passCount + 1
If passCount = 2 Then
If AreStringsIdentical(binStat, "High") Then
binStat = "Medium"
passCount = 0
ElseIf AreStringsIdentical(binStat, "Medium") Then
binStat = "Low"
passCount = 0
ElseIf AreStringsIdentical(binStat, "Low") Then
passCount = 0
End If
End If
ElseIf AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Failed") Then
passCount = 0
If AreStringsIdentical(binStat, "High") Then
binStat = "High"
ElseIf AreStringsIdentical(binStat, "Medium") Then
binStat = "High"
ElseIf AreStringsIdentical(binStat, "Low") Then
binStat = "Medium"
End If
Else
arrayOfValues(rowIndex, writeColumnIndex) = "Unexpected value '" & arrayOfValues(rowIndex, columnIndex) & "'"
End If
Next columnIndex
arrayOfValues(rowIndex, writeColumnIndex) = binStat
Next rowIndex
.Range("C2").Resize(UBound(arrayOfValues, 1), UBound(arrayOfValues, 2)).Value2 = arrayOfValues
End With
End Sub
Private Function AreStringsIdentical(ByVal firstString As String, ByVal secondString As String) As Boolean
' Performs case-sensitive comparison.
AreStringsIdentical = (VBA.Strings.StrComp(firstString, secondString, vbBinaryCompare) = 0)
End Function
add a comment |
Maybe something like this (uses sub rather than function):
Option Explicit
Sub AssignRowValuesToBins()
' Change to whatever your sheet is called. I assume Sheet1.
With ThisWorkbook.Worksheets("Sheet1")
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Dim arrayOfValues() As Variant
arrayOfValues = .Range("C2:DG" & lastRow).Value2
Dim rowIndex As Long
Dim columnIndex As Long
Dim binStat As String
Dim passCount As Long
Dim writeColumnIndex As Long
writeColumnIndex = UBound(arrayOfValues, 2)
For rowIndex = LBound(arrayOfValues, 1) To UBound(arrayOfValues, 1)
binStat = "High"
passCount = 0
For columnIndex = LBound(arrayOfValues, 2) To (writeColumnIndex - 1)
If AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Passed") Then
passCount = passCount + 1
If passCount = 2 Then
If AreStringsIdentical(binStat, "High") Then
binStat = "Medium"
passCount = 0
ElseIf AreStringsIdentical(binStat, "Medium") Then
binStat = "Low"
passCount = 0
ElseIf AreStringsIdentical(binStat, "Low") Then
passCount = 0
End If
End If
ElseIf AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Failed") Then
passCount = 0
If AreStringsIdentical(binStat, "High") Then
binStat = "High"
ElseIf AreStringsIdentical(binStat, "Medium") Then
binStat = "High"
ElseIf AreStringsIdentical(binStat, "Low") Then
binStat = "Medium"
End If
Else
arrayOfValues(rowIndex, writeColumnIndex) = "Unexpected value '" & arrayOfValues(rowIndex, columnIndex) & "'"
End If
Next columnIndex
arrayOfValues(rowIndex, writeColumnIndex) = binStat
Next rowIndex
.Range("C2").Resize(UBound(arrayOfValues, 1), UBound(arrayOfValues, 2)).Value2 = arrayOfValues
End With
End Sub
Private Function AreStringsIdentical(ByVal firstString As String, ByVal secondString As String) As Boolean
' Performs case-sensitive comparison.
AreStringsIdentical = (VBA.Strings.StrComp(firstString, secondString, vbBinaryCompare) = 0)
End Function
Maybe something like this (uses sub rather than function):
Option Explicit
Sub AssignRowValuesToBins()
' Change to whatever your sheet is called. I assume Sheet1.
With ThisWorkbook.Worksheets("Sheet1")
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Dim arrayOfValues() As Variant
arrayOfValues = .Range("C2:DG" & lastRow).Value2
Dim rowIndex As Long
Dim columnIndex As Long
Dim binStat As String
Dim passCount As Long
Dim writeColumnIndex As Long
writeColumnIndex = UBound(arrayOfValues, 2)
For rowIndex = LBound(arrayOfValues, 1) To UBound(arrayOfValues, 1)
binStat = "High"
passCount = 0
For columnIndex = LBound(arrayOfValues, 2) To (writeColumnIndex - 1)
If AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Passed") Then
passCount = passCount + 1
If passCount = 2 Then
If AreStringsIdentical(binStat, "High") Then
binStat = "Medium"
passCount = 0
ElseIf AreStringsIdentical(binStat, "Medium") Then
binStat = "Low"
passCount = 0
ElseIf AreStringsIdentical(binStat, "Low") Then
passCount = 0
End If
End If
ElseIf AreStringsIdentical(arrayOfValues(rowIndex, columnIndex), "Failed") Then
passCount = 0
If AreStringsIdentical(binStat, "High") Then
binStat = "High"
ElseIf AreStringsIdentical(binStat, "Medium") Then
binStat = "High"
ElseIf AreStringsIdentical(binStat, "Low") Then
binStat = "Medium"
End If
Else
arrayOfValues(rowIndex, writeColumnIndex) = "Unexpected value '" & arrayOfValues(rowIndex, columnIndex) & "'"
End If
Next columnIndex
arrayOfValues(rowIndex, writeColumnIndex) = binStat
Next rowIndex
.Range("C2").Resize(UBound(arrayOfValues, 1), UBound(arrayOfValues, 2)).Value2 = arrayOfValues
End With
End Sub
Private Function AreStringsIdentical(ByVal firstString As String, ByVal secondString As String) As Boolean
' Performs case-sensitive comparison.
AreStringsIdentical = (VBA.Strings.StrComp(firstString, secondString, vbBinaryCompare) = 0)
End Function
answered Nov 12 at 15:47
chillin
974134
974134
add a comment |
add a comment |
Thanks for contributing an answer to Stack Overflow!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
Some of your past answers have not been well-received, and you're in danger of being blocked from answering.
Please pay close attention to the following guidance:
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53264904%2fhow-can-i-run-a-vba-i-wrote-against-all-of-the-rows-of-my-excel-sheet%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
@Comintern you're correct I apologize. VBA. Not script. Sorry new enough at VB that I did not initially know there were differences and I needed specifics.
– Adam
Nov 12 at 15:10
1
Do you want it to run over 27,000 rows or on 250ish columns from
C
toDF
?– FreeMan
Nov 12 at 15:12
@FreeMan Place result in DG when run against the values C:DF
– Adam
Nov 12 at 15:14