I'm trying to add excel files to an access database. I'd like to have each room name searchable by room number. Right now, if you query the room number, it only comes up with the row containing that room number, even though the rows below the room number also contain data for that same room... like so:
http://i802.photobucket.com/albums/yy304/Growler2009/Database_Fill_In.jpg
So, what I'd like to do is write a script that will scan through the room number column (Column 1)... each time the script lands upon a unique room number, it fills in the blank spaces below it with that same room number.
After:
http://i802.photobucket.com/albums/yy304/Growler2009/BlankSpace_FillIn.jpg
So far I've written this test script... but it doesn't seem to be working... Any tips?
Thanks!
RoomNumber = Array(1, 2, 3, 4, 5)
For RoomNumberRow = 1 To 5
For ColIndex = 1 To 5
If Cells(RoomNumberRow, ColIndex).Value = RoomNumber(RoomNumberRow) Then
'Move down a cell
ActiveCell.Offset(1, 0).Select
'changes that cell to the same room number
Cells.Value = RoomNumber(RoomNumberRow)
End If
Next RoomNumberRow
Assuming the materialDescriptionColumn is not empty until the end of the list, and the roomNumberValue is not empty in the first row.
If all the columns have empty fields before the end of the list, a For loop would be an option.
counter = 'First row.
Do Until IsEmpty(Cells(counter, materialDescriptionColumn).Value)
roomNumberValue = Cells(counter, roomNumberColumn).Value
If roomNumberValue = "" Then
Cells(counter, roomNumberColumn) = roomNumber
Else
roomNumber = roomNumberValue
End If
counter = counter + 1
Loop
Related
I am writing a Macro in Excel which is supposed to delete entire Rows, or add Rows, based on input.
Now the amount of rows to be deleted should be determined based on the amount of Rows which are already there, so say if I have 12 Rows and a cell nearby with a Sum amount of 3, I have used the Cell value so far to determine the amount of Rows to be removed.
|1(A1)| Title (B1)
|1(A2)| Title (B2)
|1(A3)| Title (B3)
|3(A4)| Sum (B4)
Here is the code I am using(the removing part, haven't gotten further yet):
If CInt(TextBox2.Value) = Cells(4, 1) Then
MsgBox ("Values are equal")
ElseIf CInt(TextBox2.Value) < Cells(34, 2) Then
a = Cells(4, 1) - CInt(TextBox2.Value)
For i = 1 To a
Rows(1).EntireRow.Delete
Next
End If
The Problem What I have realised with this is, that the Summation Cell which I use to determine the Amount of Rows to be deleted, will move if I delete a Row, so it will not be at position (4,1) (::A4::) anymore.
My Question: Is there a way to use the cell with an ID which would never
change, or dynamically change the addressed Value of the Cell ?
Thanks a lot in Advance!
If you Set a reference to a cell and delete cells above so that the cell move up, the cell reference will be updated accordingly. See following example:
Function testCellRef()
Dim c As Range, i As Long
Set c = [A18]
For i = 1 To 10
Range("A" & i).EntireRow.Delete
Debug.Print "Deleted row " & i & ", cell Address is now " & c.Address
Next i
End Function
will display in the immediate window:
Deleted row 1, cell Address is now $A$17
Deleted row 2, cell Address is now $A$16
Deleted row 3, cell Address is now $A$15
Deleted row 4, cell Address is now $A$14
Deleted row 5, cell Address is now $A$13
Deleted row 6, cell Address is now $A$12
Deleted row 7, cell Address is now $A$11
Deleted row 8, cell Address is now $A$10
Deleted row 9, cell Address is now $A$9
Deleted row 10, cell Address is now $A$9
Note that the last iteration, the row that is deleted (row 10) is below the cell tracked and so the address doesn't change.
Note also that if you replace [A18] by [A17], you will delete the row with the tracked cell and then the reference will become invalid at the 9th iteration and generate an error at the c.Address call.
You could find the row that contains the Sum formula each time by using something like this:
Columns("A").Find("=SUM", , xlFormulas, , xlRows, xlPrevious).Value
That will search column A, starting at the last row and working up and will return the value of the cell that contains "=SUM". If you have more than one cell with that you may need to change the direction or go another route.
Another option would be adding a variable like the example below:
x = 0
If CInt(TextBox2.Value) = Cells(4 + x, 1) Then
MsgBox ("Values are equal")
ElseIf CInt(TextBox2.Value) < Cells(34 + x, 2) Then
a = Cells(4 + x, 1) - CInt(TextBox2.Value)
For i = 1 To a
Rows(1).EntireRow.Delete
x = x - 1
Next
End If
I assume you also need to change the cell you compare to in column B. When adding a row, just use x = x + 1.
To delete the rows you have to loop backwards, that way the row numbers you assume at the beginning of the loop will remain intact.
I have a data of say more than 5000 rows and 10 columns. I would like to add a text to the rows based on columns conditions.
A B C D
fname lname state clustername
1. ram giri NCE ...
2. philips sohia MAD ...
3. harish Gabari NCE ....
Based on the column state, for NCE the cluster name is "nce.net" has to be assigned to column D (clustername) and also for MAD is "muc.net" to be assigned to row 2.
could you please help me out.
Here is my code:
dim emptyrow as string
row_number = 1
lastRow = Cells(Rows.Count, "D").End(xlUp).Row
state = sheets("sheet1").rows("C" & row_number)
for each cell in selection
if instr(state, "NCE") = true then
Range(Cells(emptyrow, "D").Value = Array("nce.net")
end if
next emptyrow
Could you please help me out.
Why not a simple formula
In D1 and copy down
=IF(C1="NCE","nce.net",IF(C1="MAD","muc.net","No match"))
Doing the same this with code
Sub Simple()
Dim rng1 As Range
Set rng1 = Range([c1], Cells(Rows.Count, "C").End(xlUp))
With rng1.Offset(0, 1)
.FormulaR1C1 = "=IF(RC[-1]=""NCE"",""nce.net"",IF(RC[-1]=""MAD"",""muc.net"",""No match""))"
.Value = .Value
End With
End Sub
You may create a reference table consisting of unique state and clustername in a seperate worksheet and then pull the clustername into your original sheet using a =VLOOKUP() function ... provided there is a 1:1 relation between state and cluster ... even 1 cluster for multiple states would work. This way you avoid hardcoding and you can react quickly if cluster names change.
Example:
in Sheet2 list all countries and their associated clusternames
in Sheet1 enter =VLOOKUP(...) into first row of clustername column as per below picture and copy down for all rows
Of course you may want to have values only, not formulas in your cluster column; then you can convert formulas into values by copying and then pasting as values that cluster column after you've entered the =VLOOKUP(...) formula.
Alternatively, if e.g. you have a lot of clusternames already defined and only want to work on rows where clustername is blank, you can
filter for blank clusternames and insert the =VLOOKUP(...) only there
use a small piece of code
Sub DoCluster()
Dim R As Range, S As Integer, C As Integer, Idx As Integer
Set R = ActiveSheet.[A2] ' top left cell of table
S = 3 ' column index of State column
C = 4 ' column index of Clustername column
Idx = 1 ' start at 1st row within range
' run a loop across all rows, stop if 1st column gets blank
Do While R(Idx, 1) <> ""
' work only on rows wher cluster not yet set
If R(Idx, C) = "" Then
' now this isn't really good ... try to avoid hardcoding BY ANY MEANS
Select Case R(Idx, 3)
Case "NCE"
R(Idx, 4) = "nce.net"
Case "MAD"
R(Idx, 4) = "muc.net"
' insert other cases here as per need
' ...
' trap undefined cases
Case Else
R(Idx, 4) = "undefined"
End Select
End If
Idx = Idx + 1
Loop
End Sub
Personally I don't like this kind of hardcoding at all, I'd rather take the clusternames from a table ... so for me there wouldn't be a need to write code unless the whole task is much more complex than described.
I'm searching for a VBA macro for Excel, which can detect the word "mean", in column A. After this it would copy the yellow row with the formula in C to J.
The formula counts the average from one row after the last "mean" to the next =AVERAGE (C1323:C1437)
after every sixth mean there also needs to be Area and 150 copyied two rows after mean and I and J Need to be changed. Consequently I and J would refer to the cell A1441 in this case (=G1439/C1439*$A$1441) till the end of the file.
I'm not quite sure if it's easy or not but I'm totally overchallenged. I would be very thankful for help.
Sub Makro1()
'
' Makro1 Makro
'
' Tastenkombination: Strg+q
strSearchWord = "Mean"
i = Application.WorksheetFunction.CountIf(Range("A:A"), strSearchWord)
Y = 2
For x = i To 0
i = Application.WorksheetFunction.Match(strSuchWort, Range("A:A"), 0)
Range("C" & i).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" ' that's still wrong, should be something like i-y?
Selection.AutoFill Destination:=Range("C" & i:"J" & i), Type:=xlFillDefault
Range("CY:JY").Select
i = Y
'for each fifth i
'Range("A" & i + 3).Select
' ActiveCell.FormulaR1C1 = "=RC[-2]/RC[-6]*R2159C1"
Next x
End Sub
it's still wrong, but my first draft.
#stucharo the Area correction is difficult to describe I've added a better Picture with formulas. I hpe that now it's understandable
If your line ActiveCell.FormulaR1C1 = "=AVERAGE(R[-147]C:R[-1]C)" needs to change the number of rows betwen means each time then you'll need to add a variable as you comment suggests. Also, just writing the string to the cells value (ActiveCell.Value) means that you will see it written as a formaula when you click the cell in the workbook (and it'll highlight the range etc.). You could try replacing it with:
ActiveCell.Value = "=AVERAGE(R[" & i - Y & "]C:R[-1]C)"
although since I can't see the first row of your sheet I'm not certain that'll give you the correct range of rows each time.
If your row number is likely to change and you are copying over the same number of columns each time then it might also be just as easy to write the formula directly to cells within a loop, rather than explicitly copying it.
Adding text after every 6th "mean" would require you to keep count of how many means had passed so far. This can be done by incrememnting a counter variable and using the Mod operator will tell you the remainder after a division. Therefor numberOfMeans Mod 6 will give you the remainder when divided by 6 and when this equals zero you know you have a multiple of 6. I've tried to capture all this into the code below.....
Sub Test()
Application.ScreenUpdating = False
Dim startRow As Integer
startRow = 2
Dim endrow As Integer
endrow = Range("A2").End(xlDown).row
Dim lastMeanRow As Integer
lastMeanRow = startRow - 1
Dim areaRow as Integer
areaRow = lastMeanRow + 3
Dim meanCounter As Integer
meanCounter = 0
Dim avgColHeight As Integer
Dim col As Integer
Dim row As Integer
'Check each row in the sheet
For row = startRow To endrow
'Cols i and j in every row need to be modified
For col = 9 To 10
Cells(row, col).Value = "=RC[-2]/RC[-6]*R" & areaRow & "C1"
Next col
'If column 1 of that row contains "mean" then
If Cells(row, 1).Value = "mean" Then
'Calculate the column height to average over....
avgColHeight = row - lastMeanRow - 1
'...and loop through each of the columns....
'(including i and j to add average)
For col = 3 To 10
'....inserting the averaging formula.
Cells(row, col).Value = "=AVERAGE(R[-" & avgColHeight & "]C:R[-1]C)"
Next col
'Then increment the counter to keep track of the number of means
meanCounter = meanCounter + 1
'If the number of means is a multiple of 6 then
If (meanCounter Mod 6 = 0) Then
'insert the "Area" and "150" strings
Cells(row + 2, 1).Value = "Area"
Cells(row + 3, 1).Value = "150"
areaRow = row + 3
End If
'Finally change the lastMeanRow to the mean row we have just processed.
lastMeanRow = row
End If
'Do it again until we reach the end of the data
Next row
Application.ScreenUpdating = True
End Sub
I also noticed your point on the value of area changing periodically. Writing this programatically, as above, will aloow you to add some logic over the value of "Area" and when it changes.
You clearly have a long list of data and want to automate the creation of the rows and formulas you describe.
It is possible write VBA to scan through the data and modify the formulas etc but first I would question if this is the best approach to give you what you need.
Excel has a feature called "pivot tables" which essentially allows you to summerise data in a list.
for instance if the list had one row for each city in the world and gave the population in the city, and a column gave which country it was in. A pivot table could be used to create the average population for a country of the countries cities. I suspect you are doing this sort of thing.
If you don't know about pivot tables you should find out about them. See here
In your case your mean row is summeriseing data in the rows above it. To use pivot tables you would have to have a column that defined which group each row is in. You pivot table would sue this column as a row summary and you would then create the average for all the other column.
#Nathalie. It's hard to help without knowing more. eg Is the data delivered with the mean text already inserted. It looks like column A has a number the represent the row number within the group (and this could be used by a formula to create the "Group Name" column you need for pivot tables.
You can get the pivot tables to do the area adjustment by:
Creating a new set of columns which contains formulas that cause the values in columns C to J to be copied except for when it is the 6th set of data in which case you adjust the values in C to J accordingly).
You probably need to introduce columns that:
A. give the "group name"
B. give a count of which group it is in so every 6th you can do the adjustment you need.
4 by using pivot tables and basic techniques you will find it easie rot update the refresh the data, should you need to.
I am repeatedly performing an action on multiple columns, and would like to eliminate my redundant code. I am posting the code for the first two columns as I believe that is enough to demonstrate what I am doing, but the code is repeated for a total of 16 columns (Column E - Column T).
OldplayerRosterLocation with the offset is basically a "vba vlookup" for the old player to find where they are on the sheet so the proper row stats are modified as needed. It works, but I would like to reduce the redundant code.
'Below determines what weeks old player has already played.
'First part replaces team win/loss for that week as a value instead of
'formula so second part does not ruin sheet.
If Range("E61") = "1" Then 'Wk#1
Range("E42").Value = Range("E62")
Range("E43").Value = Range("E63")
'Second part clears weekly results for new player each weeks that the
'old player has already played.
Range(OldPlayerRosterLocation).Offset(0, 3).ClearContents
Range(OldPlayerRosterLocation).Offset(1, 3).ClearContents
Range(OldPlayerRosterLocation).Offset(2, 3).ClearContents
End If
If Range("F61") = "1" Then 'WK#2
Range("F42").Value = Range("F62")
Range("F43").Value = Range("F63")
Range(OldPlayerRosterLocation).Offset(0, 4).ClearContents
Range(OldPlayerRosterLocation).Offset(1, 4).ClearContents
Range(OldPlayerRosterLocation).Offset(2, 4).ClearContents
End If
How can I simplify this code?
I'd be sure you could use this for your 16 columns:
Dim c As Range
For Each c In Range("E61:T61")
If c = "1" Then
c.Offset(-19, 0).Value = c.Offset(1, 0).Value
c.Offset(-18, 0).Value = c.Offset(2, 0).Value
For j = 0 To 2
Range(OldPlayerRosterLocation).Offset(j, c.Column - 2).ClearContents
Next
End If
Next
c is a range object (a cell in this case). So we use For Each ... In instead of For ... To. c.Column gives the column number of c. When we subtract 2, we get the number of columns to Offset, where you want to ClearContents.
Use the Resize() function
Range(OldPlayerRosterLocation).Offset(0,3).Resize(3,1).ClearContents
...
Range(OldPlayerRosterLocation).Offset(0,4).Resize(3,1).ClearContents
It takes a single cell and creates a range spanning 3 rows and 1 column. Also commonly used for fast value transfers. For example:
Range("B1").Resize(100,1).Value = Range("A1").Resize(100,1).Value
copies 100 rows from A1 into B1. For you, I proposed the following style changes:
' Old Code
'Range("E42").Value = Range("E62")
'Range("E43").Value = Range("E63")
' New Code
Range("E42").Resize(2,1).Value = Range("E62").Resize(2,1).Value
I have multiple spreadsheets that each roughly look like this:
I'm trying to find a way to go through each of the SPEAKER HEADERS in Row 1, and summarize the scores that are associated with the corresponding survey question ("Was the CONTENT good? Was the SPEAKER relevant? What the DELIVERY good?) grouped by color.
I can't think of a clever way of doing this automatically.
I can get the RANGE SPANS of the Merged Cells like this:
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
MsgBox Cell.MergeArea.Address
End If
Next
I then need to iterate over the range provided by the address, getting the numerical values in all the rows BELOW that range.
For example, running the current macro produces this:
I need to take $C$1:$E$1 and run a for loop that say FROM C1 to E1 average all the numbers in the rows below it. I have no idea how to do this.
I was thinking about augmenting the selection in include everything used
Is there a better way to do this?
This is the tragically bad way I'm doing it now (which I'm quite proud of on account of being new to excel):
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
Set rng = Range(Cell.MergeArea.Address) 'Equal to the Address of the Merged Area
startLetter = Mid(rng.Address, 2, 1) 'Gets letter from MergeArea Address
endLetter = Mid(rng.Address, 7, 1) 'Gets letter from MergeArea Address
On Error GoTo ErrHandler:
Set superRange = Range(startLetter & ":" & endLetter)
ErrHandler:
endLetter = startLetter
Set superRange = Range(startLetter & ":" & endLetter)
Resume Next
superRange.Select
MsgBox Application.Average(Selection)
In order to get rid of the error you are having, you need to change:
Set rng = Cell.MergeArea.Address
to
Set rng = Range(Cell.MergeArea.Address)
Ideally, this data would be better stored in a database so that it could be queried easily. If that's not an option, then the way you are going at it in Excel is as valid as most any other approach.
EDIT
Once you obtain the address of the left-most column for each of your speakers, you can loop through each column to obtain averages.
'Number of columns in the current speaker's range.
numColumns = rng.Columns.Count
'First row containing data.
currentRow = 4
'First column containing data.
firstColumn = rng.Column
'Loop through each column.
For col = firstColumn to firstColumn + (numColumns -1)
totalValue = 0
'Loop through each row.
Do While Cells(currentRow,col).value <> ""
totalValue = totalValue + Cells(currentRow,col).Value
currentRow = currentRow + 1
Loop
averageValue = totalValue / (currentRow - 3)
'Reset the currentRow value to the top of the data area.
currentRow = 4
'Do something with this average value before moving on to the next column.
Next
If you don't know what row is the start of your data, you can keep checking every row below rng.Row until you hit a numeric value.
The method above assumes that you have no blank entries in your data area. If you have blank entries, then you should either sort the data prior to running this code, or you would need to know how many rows you must check for data values.