Currently I have a worksheet which has different colored cells in it like the one below:
[currentsheet] http://imgur.com/na6nvNH
I am using an array to count the colored cells per column. Here is my a snippet of my code:
Dim difference(0 To 41) As Long
For Each mycell In ActiveWorkbook.Worksheets("Differences").UsedRange
Dim col As Long
col = mycell.Column
If ActiveWorkbook.Worksheets("Differences").Cells(mycell.Row,mycell.Column).Interior.Color = vbRed Then
difference(col) = difference(col) + 1
End If
Next mycell
Sheets("Summary").Cells(47, 3) = difference(0)
Sheets("Summary").Cells(48, 3) = difference(1)
Sheets("Summary").Cells(49, 3) = difference(2)
etc.
Which will list the amount of colored cells I have per column. I need help breaking this down so I can create a table which shows the number of colored cells per department. I have no idea on how to do this!
To make it easier to view I am looking to create this:
[FinalSheet] http://imgur.com/i6W60m7
I should add: the amount of rows within the sheet can vary, they can also vary per department
Tried applying a column filter beginning with the first department and then counting the colored cells once the filter was applied, however since I am looking at every cell in the code above the result is still per column.
For anyone looking for an answer to this, a rather long method. However, I applied a filter and then set the range to only the visible cells instead of the used range in the whole worksheet
It seems it would be a lot easier to use a multi dimensional array, so you would have Array(4,7) so some sudo code might look like. I could do real code, but you seem to know what your doing.
Select Case mycell.row
Case 1
Array(1,Col) = Array(1,Col) + 1
Case 2
Array(1,Col) = Array(1,Col) + 1
Case 3
Array(2,Col) = Array(2,Col) + 1
end select
The trick to a multi dimensional array is to think of it like a spread sheet, (2,2) = 3 rows, by 3 columns ... (3 because arrays start at 0) The beauty of it is, if you do it this way when it comes to extract the data you simply put a double loop
For I =0 to Ubound(Array)
For II = 0 to Ubound(Array,2)
Cell(I,II).Value = Array(I,II)
next
next
Related
For whatever reason, the If zoneChanged.Columns(-5).Value <> correctZone.Columns(2).Value Then statement always evaluates as true, despite values in the cells being the same. Perhaps at this point the values are never the same, but I cannot figure out why. Also, the results that are returned alternate between two set of values even though that is not intended. Here's the code in whole:
Sub panelSearch()
Dim Pos As Long
Dim i As Long
Dim cellFieldSet As Range
Dim cellSearchSet As Range
Dim cellBeingSearched As Range
Dim cellBeingSearchedFor As Range
Dim zoneChanged As Range
Dim correctZone As Range
Dim interVal As Range
'Area I am attempting to search
Set cellSearchSet = Range("U2:U8184") '8184
'Values I am searching for
Set cellFieldSet = Range("AI2:AI615")
i = 0
For Each cellBeingSearched In cellSearchSet
For Each cellBeingSearchedFor In cellFieldSet
Pos = InStr(cellBeingSearched, cellBeingSearchedFor.Value)
If Pos > 0 Then 'code if found
Set zoneChanged = cellBeingSearched
Set correctZone = cellBeingSearchedFor
'-4142 is default color index
If zoneChanged.Columns(-5).Interior.ColorIndex = -4142 Then
'This control statement always evaluates as true even when the two cells should be the same
If zoneChanged.Columns(-5).Value <> correctZone.Columns(2).Value Then
'Need to add counter to keep multiple results from changing cell multiple times
zoneChanged.Columns(-5).ClearContents
zoneChanged.Columns(-5) = zoneChanged.Columns(-5) & correctZone.Columns(2)
zoneChanged.Columns(-5).Interior.Color = RGB(255, 0, 0)
'Counter for multiple results
If i > 0 Then
zoneChanged.Columns(-5).Interior.Color = RGB(128, 128, 128)
End If
End If
i = i + 1
End If
End If
Next cellBeingSearchedFor
Next cellBeingSearched
End Sub
Now that #DisplayName pointed out that my explanation was not correct, I got a bit deeper into it. Nevertheless the solution does not change, just my explanation why.
So the issue in the question was obviously, that it just shifted the wrong amount of columns because of (at first glance) a very odd counting system of the column property (which is not that odd if we looked into it).
Counting of Columns
When dealing with row/column counts, Excel starts counting at 1. So if we do Column(1).Select it selects the first column which is A. So the parameter we give at the column property is the column number (and not the amount we want to shift).
So because Column(1) is the first column (eg. of a selected range) that means that Column(0) is one left of the first column (of the selected range).
So if we use column for shifting .Columns(-1) shifts the selection 2 columns to the left, and yes I mean TWO.
Columns(5).Columns(-1).Select
Debug.Print Selection.Column '= 3
If we think in shifting we would await that this selects column 4 (go one left). But it selects the column number -1 where the current column is column number 1. So counting from 1 (current) to -1 (destination) it is 2 steps left of 1 and that's why it shifts 2 left.
Conclusion
I conclude that Columns() should be used to jump to a specific column number. But when we want to shift (a specific amount of columns) relatively to the current selection we should use Offset() for a convenient counting.
Counting of Offset
So Offset is shifting as expected where .Offset(0, -1) shifts selection 1 column to the left (as -1 let us expect).
To go 5 cells left use .Offset(0, -5) instead. Same for .Columns(2) should be .Offset(0, 2) accordingly.
Columns(5).Offset(0, -1).Select
Debug.Print Selection.Column '= 4
For more information look into the documentation: Range.Offset Property (Excel)
I believe that's because you're using a negative value (-5) as index for columns.
As far as I know you should use a positive number as index.
hopefully someone will be able to help me. I need to write a query, which would shrink the data from multiple columns (in my case from columns A:H) into one column.
The original file looks like this:
I need to shrink the data one by one by rows. I mean, the query has to check the first row and take the data (name), and put it into "a new column" then check the second column and do the same, and continue like this one by one. The table has 170 rows.
I found a query that is shrinking the data from multiple columns into one column but in another order than I need. The query is taking as first all data from a column A and putting it into "a new column", then taking all data from a column B and putting it into "a new column" under the data from the previous column (column A).
This is the query I tried to apply:
Please could somebody help me with it? I have to admit that I have not use UBound and LBound functions and I am getting pretty lost here. :(
I will be thankful for any advise how to adjust this query.
Many thanks in advance! :)
Try this. I'm first setting your range to an array. I then loop through the array and 'slice' each row using Application.Index. It then Joins all the content in that row together before Trimming the whitespace left over from either end. This leaves me with the one value in my results array (tmp). The code then clears your source data before leaving all your data in one column.
Sub CombineColumns()
Dim rng As Range
Dim tmp As Variant, vaCells As Variant
Dim i As Long
Set rng = Sheets("DATA").Range("A2:H200")
vaCells = rng.Value2
ReDim tmp(LBound(vaCells) To UBound(vaCells))
For i = LBound(tmp) To UBound(tmp)
tmp(i) = Trim(Join(Application.Index(vaCells, i, 0)))
Next i
With rng
.ClearContents
.Cells(1).Resize(UBound(tmp)).Value2 = Application.Transpose(tmp)
End With
End Sub
LBound returns the lowest position in the array (usually 0 or 1) and UBound returns the highest
I think something like this
for i = 1 to 170
for y = 1 to 8
if worksheets("trainers").cells(i,y).value <> "" then
worksheets("output").cells(i,1).value = worksheets("trainers").cells(i,y).value
exit for
end if
next y
next i
or on same sheet
For i = 1 To 170
Z = 0
For y = 1 To 8
If Cells(i, y).Value = "" Then
Cells(i, y).Delete Shift:=xlToLeft
Z = Z + 1
If Z <= 8 Then y = y - 1
End If
Next y
Next i
It might be the most silly question in planet. how can I merge two cell values vertically in a repeated manner. as like this:
Column A and B has 400+ cells therefore it is impossible to do what I want to achieve manually.
Note: I want to merge B into A.
You can create a simple loop in VBA that runs through each cell in the data range then adds it to the output column
Sub Merge()
Dim data As Range
Dim cell As Range
Dim output As Range
Dim i As Integer
Set data = Range("A2:B4")
Set output = Range("D2")
i = 0
For Each cell In data
output.Offset(i, 0) = cell
i = i + 1
Next
End Sub
You can use the INDEX function to refer to each cell. If data is in A2:B4, this formula works in any column but must start in row 2 and can then be filled down:
=INDEX($A$2:$B$4,ROW()/2,MOD(ROW(),2)+1)
The formula uses the current row as a counter. On every even row it gets a value from the first column of data and on every odd row it gets a value from the second column of data. After every 2 rows it gets values from the next row of data.
I have seen some VBA examples on here allowing one to merge set numbers of cells, but none exactly as I need it.
What I would like to do is go down the entire column A:A and merge every four rows, starting with cell A4. I know this involves changing the reference cell but I'm not skilled enough with the language to know how to do this without screwing up the cycle.
Here is an example of the data I would like to format. Thanks in advance for any and all help with this.
Simply set Count to the number of merged cells that you want and run the MergeColA.
Sub MergeColA()
Dim Count As Integer
Count = 10
MergeCells (Count)
End Sub
Sub MergeCells(Count As Integer)
For i = 4 To 4 * count Step (4)
Dim r As Range
Set r = Range("A" & i, "A" & i + 3)
r.Merge
Next i
End Sub
In Excel I've got sequential box numbers in column B, and each box has a couple dozen files that need sequential-by-box place numbers in column C. The way I usually do this is to Fill Series down a selection (selected by hand) of all the cells for that box in Column C, which is fine if you've got a few boxes to do, but now I have several hundred.
[I've got a 394x290 example screenshot I was going to include to show what I mean, but since this is my first post I don't have enough rep, sorry -- link to it on g+ here.]
I thought I could put some VBA code into a macro to select the contiguous cells with the same box number, offset one column right [Offset (0, 1), yeah?], fill series those cells from 1, and go on to the next box. But I haven't had any luck finding anything similar that's been done, nor have I been able to get anything I've looked up to work for this. (Not surprising since I rarely try VBA, hopefully my question's not too noobish for this site.)
From what I can tell, you want the Plc column to fill up series starting from 1 for the same Box Num.
There may exist a fast and quick way but simple method is to go through the rows. Try below:
Sub FillUpPlc()
Dim oRng As Range, n As Long ' n used for series filling
Application.ScreenUpdating = False
n = 1
Set oRng = Range("B2")
Do Until IsEmpty(oRng)
' Increment n if it's same as cell above, otherwise reset to 1
If oRng.Value = oRng.Offset(-1, 0).Value Then
n = n + 1
Else
n = 1
End If
oRng.Offset(0, 1).Value = n ' Store n to next column
Set oRng = oRng.Offset(1, 0) ' Move to next row
Loop
Set oRng = Nothing
Application.ScreenUpdating = True
End Sub
No need to break out the VBA. This can be done with a formula. Starting in C2 and copied down
=IF(B2<>B1,1,C1+1)
Much, much faster than VBA looping through thousands of rows.