Never used VBA before and basically just trying write this sub:
Sub Populate_Empties()
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim m As Integer
Dim k As Integer
' test for 50 rows...then change i from 2 to 278970
m = 2
For k = 3 To 8
For i = 2 To 50
If (IsEmpty(Cells(i, k).Value)) Then
m = i 'any statement
Else
j = i - 1
For n = m To j
Cells(n, k).Value = Cells(i, k).Value
m = i + 1
End If
End Sub
I keep getting error End If without Block
Any suggestions?
You're missing the closing statements on your for loops
Sub Populate_Empties()
Dim i As Integer
Dim j As Integer
Dim n As Integer
Dim m As Integer
Dim k As Integer
' test for 50 rows...then change i from 2 to 278970
m = 2
For k = 3 To 8
For i = 2 To 50
If (IsEmpty(Cells(i, k).Value)) Then
m = i 'any statement
Else
j = i - 1
For n = m To j
Cells(n, k).Value = Cells(i, k).Value
Next n
m = i + 1
End If
Next i
Next k
End Sub
Related
I'm brand new to programming, and I figured VBA is a good place for me to start since I do a lot of work in Excel.
I created a macro that takes an integer from an input box (I've been using 2, 3 and 4 to test) and it creates a set of a 4-tier hierarchy of that number; e.g. entering "2" would produce
1.0.0.0
1.0.0.1
1.0.0.2
1.0.1.0
1.0.1.1
1.0.1.2 etc.
I got the macro to work as intended, but it takes forever to run. I think it's the offsets within the loops that are slowing it down. Does anyone have any suggestions to speed this up? Any general feedback is welcome as well.
Sub Tiers()
'Input Box
Dim Square As Integer
Square = InputBox("Enter Number of Tiers")
Range("f5").Select
Selection.Value = 0
With Application
.ScreenUpdating = False
End With
'Rows down
Dim g As Integer
Dim h As Integer
Dim i As Integer
Dim j As Integer
'Start For loops
For g = 1 To Square
For h = 0 To Square
For i = 0 To Square
For j = 0 To Square
'calculate offsets and place values of loop variables
Dim step As Long
step = ((g - 1) * (Square + 1) ^ 3 - 1 + (h * (Square + 1) ^ 2) + Square * i + i + j + 1)
Selection.Offset(step, 0).Value = j
Selection.Offset(step, -1).Value = i
Selection.Offset(step, -2).Value = h
Selection.Offset(step, -3).Value = g
Next j
Next i
Next h
Next g
With Application
.ScreenUpdating = True
End With
End Sub
Thanks
Further to my comment below your post, looping and writing to sheets like this will be too slow. Write to an array and then write the array to worksheet. This ran in a blink of an eye.
Is this what you are trying?
Sub Sample()
Dim TempArray() As Long
Dim n As Long
Dim g As Long, h As Long, i As Long, j As Long
Dim reponse As Variant
'~~> Accept only numbers
reponse = Application.InputBox(Prompt:="Enter Number of Tiers", Type:=1)
If reponse <> False Then
For g = 1 To reponse
For h = 0 To reponse
For i = 0 To reponse
For j = 0 To reponse
n = n + 1
Next j
Next i
Next h
Next g
ReDim Preserve TempArray(1 To n, 1 To 4)
n = 1
For g = 1 To reponse
For h = 0 To reponse
For i = 0 To reponse
For j = 0 To reponse
TempArray(n, 1) = g
TempArray(n, 2) = h
TempArray(n, 3) = i
TempArray(n, 4) = j
n = n + 1
Next j
Next i
Next h
Next g
'~~> Replace this with the relevant sheet
Sheet1.Range("A1").Resize(UBound(TempArray), 4).Value = TempArray
End If
End Sub
Screenshot:
The step calculation seems superfluous:
step = ((g - 1) * (Square + 1) ^ 3 - 1 + (h * (Square + 1) ^ 2) + Square * i + i + j + 1)
Try the following:
Sub Tiers()
'Input Box
Dim Square As Long
Square = InputBox("Enter Number of Tiers")
With Application
.ScreenUpdating = False
End With
'Rows down
Dim g As Long
Dim h As Long
Dim i As Long
Dim j As Long
Dim step As Long
step = 1
For g = 1 To Square
For h = 0 To Square
For i = 0 To Square
For j = 0 To Square
Range("F5").Offset(step, 0).Value = j
Range("F5").Offset(step, -1).Value = i
Range("F5").Offset(step, -2).Value = h
Range("F5").Offset(step, -3).Value = g
step = step + 1
Next j
Next i
Next h
Next g
With Application
.ScreenUpdating = True
End With
End Sub
So I've this challenge. But first a little information for you: p goes from 1 to 24.
When p is 1 and Cells(X,4)>0 then I want to store all the values when this is true (it might be true several times, while it loops down the 2000 rows) into a value in Worksheets("myvalues").Cells(6,11).Value = a.
After this, I want p to be 2 and then do the same, and store the sum of these into Worksheets("myvalues").Cells(7,11).Value = a.
And so on until p is 24 (incl. 24)
Option Explicit
Sub main()
Dim x As Integer
Dim rowshift As Integer
Dim a As Double
Dim b As Integer, p as Integer
For x = 2 To 2000
If Worksheets("DATA").Cells(x, 2) = p And Worksheets("DATA").Cells(x, 4) > 0 Then
a = a+ Worksheets("DATA").Cells(x, 5)
p=p+1
End If
For rowshift = 6 to 29
Worksheets("myvalues").Cells(rowshift, 11).Value = a
Might this do what you intend?
Sub Main()
Dim TargetRow As Long
Dim Spike As Double
Dim p As Integer
Dim R As Long
TargetRow = 6
For p = 1 To 24
For R = 2 To 2000
With Worksheets("DATA").Rows(R)
If (.Cells(2).Value = p) And (.Cells(4).Value > 0) Then
Spike = Spike + .Cells(5).Value
End If
End With
Next R
Worksheets("MyValues").Cells(TargetRow, 11).Value = Spike
Spike = 0
TargetRow = TargetRow + 1
Next p
End Sub
To obtain the equivalent of Excel's formula
=SUMIFS(Data!$E$2:$E$2000,Data!$B$2:$B$2000,ROW()-5,Data!$D$2:$D$2000,">0")
using VBA, I suggest you change your code to have a loop within a loop
Option Explicit
Sub main()
Dim x As Long
Dim rowshift As Long
Dim a As Double
For rowshift = 6 to 29
a = 0
For x = 2 To 2000
If Worksheets("DATA").Cells(x, 2) = rowshift - 5 And _
Worksheets("DATA").Cells(x, 4) > 0 Then
a = a + Worksheets("DATA").Cells(x, 5)
End If
Next
Worksheets("myvalues").Cells(rowshift, 11).Value = a
Next
End Sub
I think you need to set p value.
Please try this full code.
Option Explicit
Sub main()
Dim x As Integer
Dim rowshift As Integer
Dim a As Double
Dim b As Integer, p as Integer
p = 1
For x = 2 To 2000
a = 0
If p < 25 Then
If Worksheets("DATA").Cells(x, 2) = p And Worksheets("DATA").Cells(x, 4) > 0 Then
a = a+ Worksheets("DATA").Cells(x, 5)
p=p+1
End If
End If
If a > 0 Then
For rowshift = 6 to 29
Worksheets("myvalues").Cells(rowshift, 11).Value = a
Next rowshift
End If
Next x
I am trying to do a multiple condition search. If two parameters are equal to another two parameters in another worksheet, then do something.
The inner Do While runs once.
Sub main()
Dim mat As String
Dim sp As String
Dim colArt As Integer
colArt = 8
Dim colMat As Integer
colMat = 2
Sheets("Art.1 (2)").Activate
Dim i As Integer
i = 5
Dim j As Integer
j = 2 'Row
Do While i < 12
If (Cells(i, colArt) <> "") Then
Dim tempMat As String
tempMat = Cells(i, colArt)
Dim tempSp As Integer
tempSp = Cells(i, colArt - 1)
Do While j < 16
If (Worksheets("Mat").Cells(j, colMat) <> "") Then
Dim tempMatMat As String
tempMatMat = Worksheets("Mat").Cells(j, colMat)
If (StrComp(tempMat, tempMatMat, vbTextCompare) = 0) Then
MsgBox (tempMatMat)
End If
End If
j = j + 1
Loop
End If
i = i + 1
Loop
End Sub
Federico, you need to reset j each time you loop in the outer loop:
Do While i < 12
j = 2
If (Cells(i, colArt) <> "") Then
Dim tempMat As String
tempMat = Cells(i, colArt)
I have to print the sequential 25 prime numbers after I ask the user to input a number. The code below indeed does print prime numbers but it prints empty spaces. I can't figure out how to make it print ONLY the prime numbers and no empty spaces. I have this thus far:
Public Function IsPrime(value)
Dim remainder As Double
Dim rounded As Long
Dim Max As Long
Dim j As Long
IsPrime = 0
Max = 1 + Int(value / 2)
For j = 2 To Max
rounded = Int(value / j)
remainder = (value / j) - rounded
If remainder = 0 Then
Exit For
End If
Next j
If j = Max + 1 Or value = 2 Then
IsPrime = 1
End If
If value <= 1 Then
IsPrime = 0
End If
End Function
Public Sub printprime()
Dim x As Integer
Dim row As Integer
Dim col As Integer
Dim j As Integer
Dim matrix1(1 To 5, 1 To 5) As Integer
x = InputBox("Please enter a number ")
j = 1
For row = 1 To 5
For col = 1 To 5
If IsPrime(x + j) = 1 Then
Cells(row, col) = x + j
matrix1(row, col) = Cells(row, col)
End If
j = j + 1
Next col
Next row
You just need to keep going and only record the primes:
Public Sub printprime()
Dim x As Long
Dim row As Long
Dim col As Long
Dim j As Long
x = InputBox("Please enter a number ")
row = 1
col = 1
For j = x + 1 To 9999
If IsPrime(j) Then
Cells(row, col) = j
col = col + 1
If col = 6 Then
col = 1
row = row + 1
End If
If row = 7 Then Exit Sub
End If
Next j
End Sub
Here's my version
Sub print_prime()
Dim i As Integer
Dim j As Integer
Dim if_prime As Boolean
Dim Count
Count = InputBox("Enter Max Number")
For i = 2 To Count
if_prime = True
If i = 2 Then GoTo nextItem
For j = 2 To i - 1
If i Mod j = 0 Then
if_prime = False
GoTo nextItem
End If
Next j
nextItem:
If if_prime Then Debug.Print i
Next i
End Sub
I need help with a macro that exports all combinations of a range in same row each one ( I mean horizontal exports).
Every combination I want to be in one cell each time.
I want to change any time the number of strings in the range and also the number of strings combinations (In the example below 4 strings in the range and 3 for combinations)
1. A B C D -------------ABC --ABD--ACD--BCD
2. E F G H--------------EFG---EFH--EGH--FGH
3. I G K L----------------IGK----IGL---IKL---GKL
Below its a module that I found in web that is very close to what I need.
I am very new to Vba macros and I cannot achieve what I am looking for with the below code
Private NextRow As Long
Sub Test()
Dim V() As Variant, SetSize As Integer, i As Integer
SetSize = Cells(2, Columns.count).End(xlToLeft).Column
ReDim V(1 To SetSize)
For i = 1 To SetSize
V(i) = Cells(2, i).Value
Next i
NextRow = 4
CreateCombinations V, 3, 3
End Sub
Sub CreateCombinations( _
OriginalSet() As Variant, _
MinSubset As Integer, MaxSubset As Integer)
Dim SubSet() As Variant, SubSetIndex As Long
Dim SubSetCount As Integer, Bit As Integer
Dim k As Integer, hBit As Integer
Dim MaxIndex As Long
hBit = UBound(OriginalSet) - 1
ReDim SubSet(1 To UBound(OriginalSet))
MaxIndex = 2 ^ UBound(OriginalSet) - 1
For SubSetIndex = 1 To MaxIndex
SubSetCount = BitCount(SubSetIndex)
If SubSetCount >= MinSubset And SubSetCount <= MaxSubset Then
k = 1
For Bit = 0 To hBit
If 2 ^ Bit And SubSetIndex Then
SubSet(k) = OriginalSet(Bit + 1)
k = k + 1
End If
Next Bit
DoSomethingWith SubSet, SubSetCount
End If
Next SubSetIndex
End Sub
Sub DoSomethingWith(SubSet() As Variant, ItemCount As Integer)
Dim i As Integer
For i = 1 To ItemCount
Cells(NextRow, i) = SubSet(i)
Next i
NextRow = NextRow + 1
End Sub
Function BitCount(ByVal Pattern As Long) As Integer
BitCount = 0
While Pattern
If Pattern And 1 Then BitCount = BitCount + 1
Pattern = Int(Pattern / 2)
Wend
End Function
Here is a way to do it:
In your excel sheet, add an array formula like this:
A B C D E
1
2 A B C D {=k_combinations(CONCATENATE(A2;B2;C2;D2);3)}
3 E F G H {=k_combinations(CONCATENATE(A3;B3;C3;D3);3)}
Note that you should extend the array formula to columns F, G, H and so on so that you get all results. (The { and } are not to be inserted manually, they are the mark of the array formula) :
Select cells E2, F2, G2, H2, and so on to Z2
Type the formula
To validate input, press Ctrl+Shift+Enter
Put the following code into a code module.
Public Function k_combinations(ByVal chLetters As String, ByVal k As Long) As Variant
Dim chCombinations() As String
Dim uCount As Long
Dim vReturn() As Variant
Dim i As Long
uCount = Get_k_combinations(chLetters, chCombinations, k)
ReDim vReturn(0 To uCount - 1) As Variant
For i = 0 To uCount - 1
vReturn(i) = chCombinations(i)
Next i
k_combinations = vReturn
End Function
Private Function Get_k_combinations(chLetters As String, chCombinations() As String, ByVal k As Long) As Long
Dim i As Long
Dim M As Long
M = Len(chLetters)
If k > 1 Then
Get_k_combinations = 0
For i = 1 To M - (k - 1)
Dim chLetter As String
Dim uNewCombinations As Long
Dim chSubCombinations() As String
Dim j As Long
chLetter = Mid$(chLetters, i, 1)
uNewCombinations = Get_k_combinations(Right$(chLetters, M - i), chSubCombinations, k - 1)
ReDim Preserve chCombinations(0 To Get_k_combinations + uNewCombinations) As String
For j = 0 To uNewCombinations - 1
chCombinations(Get_k_combinations + j) = chLetter & chSubCombinations(j)
Next j
Get_k_combinations = Get_k_combinations + uNewCombinations
Next i
Else
ReDim chCombinations(0 To M - 1) As String
For i = 1 To M
chCombinations(i - 1) = Mid$(chLetters, i, 1)
Next i
Get_k_combinations = M
End If
End Function
Get_k_combinations is called recursively. The performance of this method is quite poor (because it uses string arrays and makes a lot of reallocations). If you consider bigger data sets, you will have to optimize it.