Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 6 years ago.
Improve this question
I know only little how to make macros in Excel.
You can find many examples through Google.
The very first result is a post from David Gainer's blog that uses Conway’s Game of Life to teach about circular reference formulas and iteration (no VBA involved):
http://blogs.office.com/2007/11/02/iteration-conways-game-of-life
Should have done this a long time ago but here's my version of Conway's Life in excel.
Here's a hack of the code. By no means a perfect solution (didn't spend an age on this) but you might be able to pick some bits out.
Private arrGrid(100, 100) As Boolean
Private arrGridNextGeneration(100, 100) As Boolean
Private Sub PopulateParentArrayData()
For k = 1 To Sheet1.Range("C2:AM20").Cells.Count
If Sheet1.Range("C2:AM20").Cells(k).Interior.Color = Sheet1.Range("A1").Interior.Color Then
arrGrid(Sheet1.Range("C2:AM20").Cells(k).Row, Sheet1.Range("C2:AM20").Cells(k).Column) = True
Else
arrGrid(Sheet1.Range("C2:AM20").Cells(k).Row, Sheet1.Range("C2:AM20").Cells(k).Column) = False
End If
DoEvents
Next
End Sub
Private Sub ApplyParentArrayData()
For k = 1 To Sheet1.Range("C2:AM20").Cells.Count
If arrGrid(Sheet1.Range("C2:AM20").Cells(k).Row, Sheet1.Range("C2:AM20").Cells(k).Column) Then
Sheet1.Range("C2:AM20").Cells(k).Interior.Color = Sheet1.Range("A1").Interior.Color
Else
Sheet1.Range("C2:AM20").Cells(k).Interior.Color = Sheet1.Range("B1").Interior.Color
End If
DoEvents
Next
End Sub
Private Sub ApplyNextGenerationArrayData()
For k = 1 To Sheet1.Range("C2:AM20").Cells.Count
If arrGridNextGeneration(Sheet1.Range("C2:AM20").Cells(k).Row, Sheet1.Range("C2:AM20").Cells(k).Column) Then
Sheet1.Range("C2:AM20").Cells(k).Interior.Color = Sheet1.Range("A1").Interior.Color
Else
Sheet1.Range("C2:AM20").Cells(k).Interior.Color = Sheet1.Range("B1").Interior.Color
End If
DoEvents
Next
End Sub
Private Function GetNeighbourCount(ByVal pintRow As Integer, ByVal pintColumn As Integer) As Integer
Dim intCount As Integer
intCount = 0
For r = pintRow - 1 To pintRow + 1
For c = pintColumn - 1 To pintColumn + 1
If r <> pintRow Or c <> pintColumn Then
If arrGrid(r, c) Then
intCount = intCount + 1
End If
End If
Next c
Next r
GetNeighbourCount = intCount
End Function
Private Sub PopulateNextGenerationArray()
Dim intNeighbours As Integer
For r = 0 To 100
For c = 0 To 100
If r > Sheet1.Range("C2:AM20").Rows(0).Row Then
If r <= Sheet1.Range("C2:AM20").Rows(Sheet1.Range("C2:AM20").Rows.Count).Row Then
If c > Sheet1.Range("C2:AM20").Columns(0).Column Then
If c <= Sheet1.Range("C2:AM20").Columns(Sheet1.Range("C2:AM20").Columns.Count).Column Then
intNeighbours = GetNeighbourCount(r, c)
If arrGrid(r, c) Then
'A1 cell
If intNeighbours < 2 Or intNeighbours > 3 Then
arrGridNextGeneration(r, c) = False
Else
arrGridNextGeneration(r, c) = True
End If
Else
'B1 cell
If intNeighbours = 3 Then
arrGridNextGeneration(r, c) = True
Else
arrGridNextGeneration(r, c) = False
End If
End If
End If
End If
End If
End If
DoEvents
Next c
Next r
End Sub
Private Sub ActionLogic()
'Application.ScreenUpdating = False
PopulateParentArrayData
PopulateNextGenerationArray
ApplyNextGenerationArrayData
'Application.ScreenUpdating = True
End Sub
To get this to work just make the background of cell A1 black, the background of cell B1 white and then add some black backgrounds in the range C2:AM20 and run the ActionLogic method.
You will need two macros. The first one should format the game sheet so the cells are square.
Have the user run this macro. After that she should enter a 1 for each cell that is alive. Use conditional formatting to turn the cell completely black (background = black if value != 0)
Now have a second macro which calculates the next step in a background sheet (another sheet). Use relative cell positioning (relative to ActiveCell) and two nested loops. When this is done, copy all values from the background sheet to the game sheet.
Search for it and look at their code. Plenty of people have made it a hobby to make full games in Excel.
Ex: http://www.geocities.jp/nchikada/pac/
Why do you say Excel is the wrong choice?
I think Excel is the best way to solve this:
Excel solves this with 1 line:
IF(OR(SUM(B2:D4)-C3=3,AND(SUM(B2:D4)-C3=2,C3=1)),1,0)
*where the above is an expression that returns the next generation value for the cell C3.
Here's the demo:
https://docs.google.com/open?id=0B4FcWULw3iQidlZSdG9GRDh0TXM
If you're in a situation where you have to implement this sort of things from scratch, then functional programming is the best way to go. Otherwise, Excel works really well. Why? Because Excel is a system that forces you to enter only pure functions. You see, the key to simulating this Game of Life is to realize that each state of the cells is a PURE FUNCTION of the previous state. Excel naturally forces you to think this way.
another tutorial on circular references in excel can be found here: http://chandoo.org/wp/2009/01/08/timestamps-excel-formula-help/
this one explains how you can insert timestamps using circular references.
Excel is definitely the wrong choice for this kind of a problem. As to how it would be possible: First learn about the game of life and then visual basic to use in Excel.
Related
I have a problem with one code.
Please help me to fix this.
There is my code :
Sub delete()
Dim i As Long
Dim art As Long
art = 2
x = "programing"
Do While art < Application.WorksheetFunction.CountA(Workbooks("11.xlsm").Worksheets("sheet1").Range("f:f")) + 1
If cell(art, 6).Value <> x Then
cell.ClearContents
End If
art = art + 1
Loop
End Sub
In your code, replace cell with cells.
Secondly you should give the worksheet name as well before cells.
like worksheets(1).cells
If you make these correction, your code will run properly.
You probably made mistake in "cell" must be "Cells".
Hope you're doing well. I'm going to preface this by saying I'm not a programmer and I'm sure the code I have started is riddled with more errors then what I think. Hopefully you can help :D.
I have an Excel sheet that gets generated from another program that comes out like this:
excel sheet
However, the size of this sheet can change with every new generation of this sheet from the other program. (ex, A can have 7 next time, and D could have 9) And the sheet as it is cannot be used easily to do the math required as I only need specific groups of information at a given time, in this example groups B and D only.
What I'm hoping to create is something that will take the sheet as its generated, and turn it into something that looks like this:
result sheet
This is the code I've written so far, but since I don't really know what I'm doing I keep running into numerous problems. Any help would be appreciated.
Option Explicit
Sub Numbers()
Dim matchesFound As Integer
Dim row As Integer
Dim c As Integer
Dim copyRow As Integer
Dim copyLocationColumn As Integer
Dim arr(2) As String
arr(0) = "1"
arr(1) = "2"
arr(2) = "3"
Function arrayContainsValue(array, varValue)
found = false
for each = 0 to array
if array(i) = varValue then
found = true
exit for
arrayContainsValue = found
End Function
row = 1
c = 1
copyLocationColumn = 1
copyRow = 1
matchesFound = 0
Do While matchesFound < 3
if arrayContainsValue(arr, ThisWorkbook.Sheets("Data").Cell(column,row))
matchesFound = matchesFound + 1
Do While ThisWorkbook.Sheets("Data").Cell(column, row)
ThisWorkbook.Sheets("postHere").Cell(copyLocationColumn, copyRow) = _
ThisWorkbook.Sheets("postHere").Cell(c + 1, row)
copyRow = copyRow+1
row = row + 1
Loop
End If
row = row + 1
Loop
End Sub
There are many logic errors to numerate in a comment, Excel highlights them automatically I'll do a summary explaining them:
1. Function can't be "in the middle" of the sub, finish the Sub (take the Function from the sub and paste until it says end sub.
2.array is a forbidden name, try with another variable name
3.For each =0 ? to array? what do you try to mean like that? For Each has to be element in something For each element in Array for example For and To are for something defined in numbers (for counter=1 to 15)
Function arrayContainsValue(***array***, varValue) '2nd problem
found = false
for each = 0 to array '3rd problem
if array(i) = varValue then
found = true
exit for
arrayContainsValue = found
End Function
....
4. you're missing a then at the end
if arrayContainsValue(arr, ThisWorkbook.Sheets("Data").Cell(column,row))
I don't get the coding logic on how relates to the problem stated (?)
I'm making a basic loop as follows:
Sub IntegerTestforSuffixFinder()
Dim i As Double
i = 1
MsgBox (i)
Do While i < 100
i = i + 1
If vbOK Then
MsgBox (i)
Else: End
End If
Loop
End Sub
This works just fine...but would I really need it to do for the actual problem I'm about to tackle is recognize i = 001. The zeroes are important place holders in this context, but it keeps correcting me to i = 1. Is there a way to stop this?
Much thanks!
You wouldn't. And you can't. But you can use the original Integer in your loop, and create a string that you can display. Try this and see if you can pull what you need from it:
Sub IntegerTestforSuffixFinder()
Dim i As Double
i = 1
MsgBox (i)
Do While i < 100
i = i + 1
If vbOK Then
'Original integer
MsgBox (i)
'3-character string created by using the Right() function
MsgBox Right("000" & i, 3)
Else: End
End If
Loop
End Sub
BTW, in your original example you realize you're starting your MsgBox at 2? You set i = 1, then you're adding 1 to it before displaying the first MsgBox. I'm thinking you probably want to move that i = i + 1 line to just before the Loop.
Try this:
Format cell - Custom. Look for Type with a "0". Type three "0" as below:
The value remains as integer.
Hello Please consider my silly question, I am stuck here since a long time
ElseIf Cells(m1, a) >= 1 And Cells(m1, a) <= 98 Then
Cells(m1, a).Font.Bold = True
here only the values without decimal point (eg. 4,56,90)etc are getting bold, values with decimal point (4.5,56.5,90.54) despite being in the rqnge are not getting filtered.
Please suggest possible problem
I think the problem is with French numbering system as the data coming is from France.
Thank you
Is there any way to consider different numbering system, with the US system....???
You should use Cells(m1,a).value as well as Cells(m1,a).value
The code below will examine the list of cell are selected before the macro is run. For each cell, if it's value is [1..98] then I take the state and toggle it.
Sub toggleBoldInSelection()
Dim cellValue
For Each curCell In Selection
cellValue = curCell.Value
If (cellValue >= 1) And (cellValue <= 98) Then
curCell.Font.Bold = Not curCell.Font.Bold 'True
End If
Next curCell
End Sub
Try this
ElseIf Val(Cells(m1, a).Value) >= 1 And Val(Cells(m1, a).Value) <= 98 Then
If you are not running this code from the sheet code area then do not forget to fully qualify the cells object. For example
ThisWorkbook.Sheets("Sheet1").Cells(m1, a).Value
SO this started as me trying to help someone else, got stumped. So basically i have values in columns B, C, and D. if have my criteria in H2 and I2 and when my criteria in H2 and I2 matches in B and C then have the corresponding answer in D to populate J2. basically a vlookup with 2 criteria.
i have something like this.
Sub test()
Dim rngCrit1 As Range
Dim rngCrit2 As Range
Dim rngAnswer As Range
Dim strTarget As String
Set rngCrit1 = Range("H2")
Set rngCrit2 = Range("I2")
Set rngAnswer = Range("J2")
Range("B2").Select
strTarget = ActiveCell.Value
Do While strTarget <> ""
With ActiveCell
If strTarget = rngCrit1 Then
If .Offset(0, 1).Value = rngCrit2 Then
rngAnswer.Value = .Offset(0, 2)
Else
.Offset(1, 0).Select
strTarget = ActiveCell.Value
End If
End If
End With
Loop
End Sub
Now this thing just crashes, no debugging or anything. I am self taught so i'm sure i screwed the pooch here somewhere.
*Note this is just to satisfy my own interest not really important, so if it takes you more than 5 min please help someone else that needs it more than I.
Val1 Val2 Val3 Crit1 Crit2 Answer
a r 12 g v 22
b r 14
c s 15
d s 16
e t 18
f t 19
g y 20
g v 22
sample data
It's great that you're trying to improve your VBA skills. The first thing I'd suggest, which will improve any macro you write, is to avoid using .Select. Work directly with the range objects. For instance:
Range("B2").Select
strTarget = ActiveCell.Value
becomes
strTarget = Range("B2").Value
Also, in general, use vbNullString or Len(variable)=0 when checking for "empty" values instead of "". As for why your program is crashing, it may be your use of With. Like Select, it should be avoided in most cases (definitely in this one). Although you update ActiveCell, it's within the scope of the With statement, so once you close it (End With), those changes to ActiveCell are undone (I would suggest stepping through the macro and watch the values of strTarget and ActiveCell). This may not be the case, but I know it holds for other variables, which is why I avoid With (and avoid reassigning values in a With statement)
Anyway, I'd add the following code and rewrite the loop as follows:
Dim r as range
set r = Range("B2") 'keep in mind this range is on the ActiveSheet, so you're better
'off explicitly naming the Sheet e.g. Sheet1.Range("B2")
strTarget1 = Range("B2").Value
strTarget2 = Range("C2").Value
Do While Len(strTarget) <> 0
If strTarget1 = rngCrit1 Then
If strTarget2 = rngCrit2 Then
rngAnswer.Value = r.Offset(0,2)
Exit Do
End If
End If
set r = r.Offset(1,0)
strTarget1 = r.Value
strTarget2 = r.Offset(0,1).Value
Loop
Keep in mind you could also loop with a Long counter i for the row, then call Sheet1.Cells(i,1).Value, Sheet1.Cells(i,2).Value and so on for the values of the different columns of that row (instead of using a range object and .Offset
EDIT: After running your code, the reason for the crash is due to your If statements. You want to go to the next cell regardless. Remove the Else and put the End If statements before the Select. Add an Exit Do after your assignment statement in the 2nd If, since you want to stop looping if your two columns meet the criteria. I've updated my code to show this, as well.
INDEX and MATCH, or SUMPRODUCT tend to work well for this. An example of the former:
http://support.microsoft.com/kb/59482
if you can guarantee val1 and val2 will be unique (e.g. when searching for g & v, there is only 1 line with g and v) then you can use sumifs
I put val1,val2 and val3 in columns A,B, & C, and the search into E,F and the answer in G, and came up with this formula
=SUMIFS(C2:C9,A2:A9,E2,B2:B9,F2)
of course, this fails if val3 is not numeric, or there are more than 1 line with the letters you are looking for