steveyyz2112
New Member
- Joined
- May 16, 2020
- Messages
- 2
- Office Version
- 2013
- Platform
- Windows
Im using 32-bit Excel 2013....Would 64 bit help me? Can anyone send me improved version to allow for HIGHER computing ability? ie 30-40 lines? thanks very much for any input!
-------------------------------------------------------------
-------------------------------------------------------------
-------------------------------------------------------------
-------------------------------------------------------------
VBA Code:
Private Sub CommandButton2_Click()
Dim inputSheet As Worksheet
Dim resultSheet As Worksheet
Set inputSheet = ActiveWorkbook.Worksheets("Sheet2")
Set resultSheet = ActiveWorkbook.Worksheets("Sheet2")
lRow = inputSheet.Cells(inputSheet.Rows.Count, "A").End(xlUp).Row
Dim letter() As String
Dim letterCount As Integer
Dim rowNum As Long, i As Long
Dim workStr As String
Dim finalArray As Variant
Dim printPlace As Range
Dim nSum As Double
Set printPlace = ActiveSheet.Range("b1")
letterCount = lRow
ReDim letter(1 To letterCount)
For i = 1 To letterCount
letter(i) = ""
Next i
'ReDim finalArray(1 To (2 ^ letterCount))
rowNum = 1
resultRow = 1
resultColumn = 2
Do
nSum = 0
For i = 1 To letterCount
If letter(i) = "" Then
letter(i) = inputSheet.Cells(i, 1).Value
Exit For
Else
letter(i) = ""
End If
Next i
workStr = ""
nSum = 0
For i = 1 To letterCount
If letter(i) <> "" Then workStr = workStr & letter(i)
If letter(i) <> "" Then nSum = nSum + CDbl(letter(i))
Next i
If Abs(nSum) < 0.001 Then
resultRow = 8
For i = 1 To letterCount
If letter(i) <> "" Then
inputSheet.Cells(resultRow, resultColumn).Value = letter(i)
resultRow = resultRow + 1
End If
Next i
inputSheet.Cells(resultRow, resultColumn).Value = 0
resultColumn = resultColumn + 1
End If
'finalArray(rowNum) = workStr
rowNum = rowNum + 1
Loop Until workStr = ""
'printPlace.Range(Cells(1, 1), Cells(2 ^ letterCount, 1)).Value = _
' Application.Transpose(finalArray)
MsgBox "Populated"
End Sub
Private Sub CommandButton1_Click()
Dim inputSheet As Worksheet
Dim resultSheet As Worksheet
Set inputSheet = ActiveWorkbook.Worksheets("Sheet4")
Set resultSheet = ActiveWorkbook.Worksheets("Sheet4")
lRow = inputSheet.Cells(inputSheet.Rows.Count, "A").End(xlUp).Row
Dim letter() As String
Dim letterCount As Integer
Dim rowNum As Long, i As Long
Dim workStr As String
Dim finalArray As Variant
Dim totalSum As Variant
Dim printPlace As Range
Dim nSum As Double
Set printPlace = ActiveSheet.Range("B1")
letterCount = lRow
ReDim letter(1 To letterCount)
For i = 1 To letterCount
letter(i) = ""
Next i
ReDim finalArray(1 To (2 ^ letterCount))
ReDim totalSum(1 To (2 ^ letterCount))
rowNum = 1
Do
For i = 1 To letterCount
If letter(i) = "" Then
letter(i) = inputSheet.Cells(i, 1).Value
Exit For
Else
letter(i) = ""
End If
Next i
workStr = ""
nSum = 0
For i = 1 To letterCount
If letter(i) <> "" Then workStr = workStr & letter(i) & ","
If letter(i) <> "" Then nSum = nSum + Format(CDbl(letter(i)), "0.00")
Next i
If Abs(nSum) < 0.001 Then
finalArray(rowNum) = workStr
totalSum(rowNum) = nSum
rowNum = rowNum + 1
End If
Loop Until workStr = ""
printPlace.Range(Cells(1, 1), Cells(2 ^ letterCount, 1)).Value = _
Application.Transpose(finalArray)
printPlace.Range(Cells(1, 2), Cells(2 ^ letterCount, 2)).Value = Application.Transpose(totalSum)
End Sub
Attachments
Last edited by a moderator: