I am new to VBA and, most of the time, I either find a code here or record a macro then change it for my needs. This time I couldn't find a proper code to change thus I need your help.
Assume that I have a table as below;
A B C
Account Name Surname
1 111 AA BB
2 111 AA BB
3 111 AA BB
4 222 CC DD
5 333 EE FF
6 333 EE FF
I want to fill the entire row with different colors (ie. 2 colors like a table formating) if "Account" column contains same values. Here, for example, rows 1-2-3 will be red, row 4 will be green, rows 5-6 will be red again. When the macro reaches the last cell it will stop.
I tried to modify conditional formatting codes however I couldn't manage it. They generally work on cells in a column based on some criteria.
Any help will be appreciated.
Many thanks in advance!
This can also be done without using VBA.
We can be sneaky by using RANK and MOD to identify "alternating groups", since Conditional Formatting works with any formula that returns only a TRUE/FALSE.
Using your example data (except row numbers adjusted to account for heading):
Instructions:
Select A2:C2; set the Fill Color to Light Red. Then with A2:C2 still selected:
Home (ribbon menu) > Conditional Formatting > New Rule…
Choose Use a formula to determine which cells to format
Choose Format cells where this value is true and enter formula:
=MOD(RANK($A2,$A:$A,1),2)=1
Click Format > Fill (tab) > Light Green > OK > OK
Ctrl+C to copy (while still on A2:C2)
Select A2:C7 and Paste Special > Formats
A simple If-Then Statement seems to be all you need. Try to follow what this code is doing below:
Sub ColorCode()
Dim thisAccount, lastAccount As String
Dim NumRows, colorValue As Integer
Dim isFirstRow As Boolean
NumRows = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
lastAccount = ""
isFirstRow = True
With Sheets("Sheet1")
For i = 1 To NumRows
thisAccount = .Range("A" & i).Value
If isFirstRow = False Then
If thisAccount <> lastAccount Then
If .Range("A" & i - 1).Interior.ColorIndex = 3
.Range("A" & i).EntireRow.Interior.ColorIndex = 4
Else
.Range("A" & i).EntireRow.Interior.ColorIndex = 3
End If
Else
colorValue = .Range("A" & i - 1).Interior.ColorIndex
.Range("A" & i).EntireRow.Interior.ColorIndex = colorValue
End If
Else
.Range("A" & i).EntireRow.Interior.ColorIndex = 3
End If
lastAccount = .Range("A" & i).Value
isFirstRow = False
Next
End With
End Sub
As opposed to the previous answer, this should account for the first row by using the initial If-statement asking if it's the first row, and because we change it's value later, the only time it will run is on the first row.
Simply put, I loop through the total number of rows in the data, ask it if the account number is the same as the previous one, and if it is, I color code them the same, and if it's not, I color code them different. I just ran this myself with some made up data and seems to work perfect.
Happy coding and next time try to ask a more code specific question!
Conditional formatting is still the way to go here.
I have to point out, that your coloring logic ("color row in respect to previos cell in row A") does not apply to the first row, and thus has to fail.
If you absolutely need to use VBA, this is the logical path you want to follow:
set column A as a range
for each cell in this range, compare this cell to the previous one (again, row 1 does not work here)
color the row based on this comparison
If you need help with the coding, update your question with what you have tried so far.
Related
What I'm trying to achieve is there are 2 whole numbers in column A & B on the same row. I want to fill the row from Column C to show the whole numbers increments of one between the two numbers.
i.e.
A B C D E F G H I J K L
1 10 1 2 3 4 5 6 7 8 9 10
any help would be appreciated.
Assuming this is Excel and you can open the VBE Editor to use VBA
Here's a macro you can run or call via a button
See the comments in the code to understand what it's doing with the Dataseries fill function
Sub FillData()
Dim intStopAt As Integer
' Set to cell indicated low end of range
Cells(1, 1).Select
' Fill in "Start At" Number
ActiveCell.Offset(0, 2).Value = ActiveCell.Value
' Retrieve and use stop number to fill in series
intStopAt = ActiveCell.Offset(0, 1).Value
ActiveCell.Offset(0, 2).DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=intStopAt
End Sub
The below code assumes you have no header and that your value in A1 is always 1, and your value in B1 is the number you want to count to.
This can be modified to be more dynamic, but taking your question as is, this should work for you.
1) Check number to count to (CountTo)
2) Run loop for 1 to CountTo and auto-populate your column headers
To run: Open VBE and paste this code on the sheet where you wish to run it.
Sub Counter()
Dim CountTo As Integer
CountTo = Range("B1").Value
For i = 1 To CountTo
Cells(1, i + 2) = i
Next i
End Sub
This can be done without VBA, perhaps not as neat initially as #dbmitch's answer because the formula has to go across to the maximum possible number.
A1 is start number, > 0
B1 is end number (> A1)
In Cell C1 enter =A1
In Cell D1 enter =IF(AND(C1<$B1,C1>=$A1),C1+1,"") and then
drag/fill right as far as you need to.
I have formulated the code so that you can now select the filled rows (A through to wherever) and fill down.
A simple explanation:
C1 sets the start of the list
The AND formula in D1 onwards checks that the immediate left cell (for D1 this is C1, for E1 this is D1 etc.) is less than the end number and greater than the start number.
If the conditions are true, use the immediate left cell value + 1 as the result.
If the conditions are false, insert a blank.
Further checking can be done, I have assumed in the above solution that the numbers are positive and increasing.
You can use helper columns to indicate if you should increase or decrease (i.e. +1 or -1 as required.
Using a blank as the other answer falls down if the numbers go from -ve to +ve. In this case, you could use another symbol (e.g. x) and check for that in the AND function as well.
you could use this:
Sub main()
Dim cell As Range
With Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants, xlNumbers) ' reference column A cells from row 1 down to last not empty one with a "constant" (i.e. not a formula result) numeric content
For Each cell In .Cells 'loop through referenced range
cell.Offset(, 2).Resize(, cell.Offset(, 1).Value - cell.Value + 1).FormulaR1C1 = "=COLUMN()-COLUMN(C3)+RC1" 'write proper formula in current cell adjacent cells
Next
.CurrentRegion.Value = .CurrentRegion.Value ' get rid of formulas and leave values only
End With
End Sub
need some help thinking through how to do this.
ultimately, what i want to achieve is to sum together cells based on if another corresponding cell is 0 or 1. it's a bit convoluted but i'll try my best to explain.
sheet 1 has data that shows, by month, if actuals have come in for the month. a column will display a 0 for accounts/month that need to be added.
sheet 2 has two tables. table 1 pulls in the 0 & 1 from sheet 1 and uses conditional formatting to highlight cells that need to be added. the only thing in this table is 0 & 1. table 2 is the exact same setup as table 1, just with the actual numbers.
my original thought was to just copy the highlighting format from table 1 onto table 2 then use a macro to sum highlighted cells. obviously, i have found that that is not possible.
i tried looking around and haven't found anything that lets me just copy the highlighting format without overwriting the numbers in table 2.
is this possible?
Try this. I'm not sure how your data is laid out, but if it's in a row, you can run this on a new cell at the end of that row (meaning, the next empty column):
Function sumHighlighted(ByVal myRng As Range)
Dim cel As Range, iRow As Range
Dim fSum As Long, totalRows As Long
fSum = 0
For Each cel In Range(Cells(myRng.Row, 1), Cells(myRng.Row, myRng.Column))
If cel.Interior.ColorIndex <> -4142 Then
fSum = fSum + cel.Value
End If
Next cel
Debug.Print "The total in this row is: " & fSum
sumHighlighted = fSum
End Function
Steps:
1. Copy the Cell with conditional Format.
2. Paste to cell where you want (Hold ALT + press E + S + T).
To generate a code, click "Record Macro" first and do the 2 steps above and stop the recording macro once you're done.
I have looked at a bunch of questions like this, but I have only found formulas, and VB examples that don't appear to check the values of cells in a column.
I was able to derive the following formula in Excel:
=IF(AND(ISNUMBER(SEARCH("Cat",R2)),OR(ISNUMBER(SEARCH("5E",R2)),ISNUMBER(SEARCH("6",R2))), ISNUMBER(SEARCH("Patch",R2)), ISNUMBER(SEARCH("Cables",R2))), "CAT 5E Ethernet Cables")
The problem is that this formula only checks for 1 out of 500 possible values. This is not productive. Plus, I have to make it one big formula when I check the entire row, because if I don't, the formula overwrites the result of the previous formula...
So, Visual Basic... I think I may have better luck scripting some kind of IF ELSE or CASE statement. I just do not understand how to do this in excel. I need to achieve the same thing as the formula above, but instead of checking for one set of conditions,
I need to check for multiple, and populate the S & T columns based on the result of each set of conditions.
I found this webpage that just mentions Excel and shows a VB IF - ELSE statement. How can I make this statement check Excel columns?
I tried the selected answer in this post with no luck:
Private Sub UpdateCategories()
Dim x As Long
For x = 1 To 5000
If InStr(1, Sheet1.Range("$B$" & x), "cat") > 0 And InStr(1, Sheet1.Range("$B$" & x), "5e") > 0 Then
Sheet1.Range("$T$" & x) = Sheet1.Range("$T$" & x) & "CAT 5E Ethernet Cables (Test)"
End If
Next
End Sub
Any help is appreciated. Thanks in advance!
Assuming you choose the route of using a data table sheet to compare to your string.
You would need to have a sheet looking like this (Maybe this is not what you want because I didn't thoroughly understand how your data looks like but the idea remains). You could have sub-category if you want, as well as category, in a third column.
column A | column B
keyword |category
CAT |ATX Cases
5e |Mini-ITX Cases
important words |MicroATX Cases
...
This would need to be filled manually. I'm not sure about the amount of data you're looking at. It can be pretty rapid if you can copy/paste stuff efficiently, depending on the form of your data.
When you have that, loop using this code. I assume the data table is in Sheet1, columns A and B and the values are in Sheet2, column A.
dim listLength as integer 'number of values to look at
dim i as integer
dim dataLength as integer 'number of keywords
dim j as integer
dim keyword as string
dim value as string
listlength = Sheet2.Cells(Rows.Count, "A").End(xlUp).Row - 1 'assuming you start on row 2
datalength = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row - 1 'assuming you start on row 2
for i = 2 to listLength + 1
value = Sheet2.Range("A")(i)
for j = 2 to dataLength + 1
keyword = Sheet1.Range("A")(j)
if instr(value, keyword) <> 0 then
' what happens when the keyword is present goes here
end if
next j
next i
I have a little problem, I occasionally bump into this kind of problem, but I haven’t found a fast solution so far.
So, imagine we have an Excel worksheet and let's suppose that we have a couple of numbers in column ’A’ with some empty cells in it. Altogether (just to make it simple) we have the first 10 cells in column 'A' to observe. For example:
3
(empty cell)
(empty cell)
6
(empty cell)
4
(empty cell)
23
(empty cell)
2
Now in the next step I would like to collect these numbers into another column (for example, column ’B’) using VBA. Obviously I just want to collect those cells which contain a number and I want to ignore the empty cells. So I would like to get a column something like this:
3
6
4
23
2
I have already written the following code, but I’m stuck at this point.
Sub collect()
For i = 1 To 10
if cells(i,1)<>"" then...
Next i
End Sub
Is there an easy way to solve this problem?
Probably the quickest and easiest way is to use Excel's Advanced Filter - the only amendment you'll need to make is it add a field name and criteria. You can even list unique items only:
The VBA equivalent is
Sub test()
With Sheet1
.Range("B1:B8").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
"D1:D2"), CopyToRange:=.Range("F1"), Unique:=False
End With
End Sub
You should be able to use the method in the post int the comments, but you could also use SpecialCells like Range("A:A").SpecialCells(xlCellTypeConstants,xlNumbers).Copy to get all of the filled cells.
Edit: needed constants not formulas.
This will work for any number of rows that you select. It will always output in the next column at the start of your selection e.g. if data starts in B10 it will ooutput in C10
Sub RemoveBlanks()
Dim cl As Range, cnt As Long
cnt = 0
For Each cl In Selection
If Not cl = vbNullString Then
Cells(Selection.Cells(1, 1).Row, Selection.Cells(1, 1).Column).Offset(cnt, 1) = cl
cnt = cnt + 1
End If
Next cl
End Sub
If you wish to loop manually and don't mind specifying the maximum row limit;
Dim i As long, values As long
For i = 1 To 10
If cells(i, 1).Value <> "" Then
values = (values + 1)
' // Adjacent column target
cells(values, 2).value = cells(i, 1).value
End If
Next i
I have a file that I only want to extract cells B9, B19, B29, etc etc etc in a pattern throughout the entire file. I would preferably like it to be extracted to a different excel file or someway so that I can do stuff with only those cells in another excel worksheet.
Potentially, I may have several excel files that I may need to do this sort of thing so if there were a way where I had the same format throughout a lot of files that I could always extract cells B9, B19, B29 that would be great. any help appreciated
I looking for syntax if possible
EDIT
Was thinking if I could somehow make an excel IF statement saying if Row has a 9 in it and the row is B then print it somewhere but I want it printed in a column
EDIT 2
I just want column B not A like I mentioned before.
B9, B19,B29,B39 through the whole file
Just in case you want to do it with code:
Sub Test()
'Assumes Sheet1 has your values and Sheet2 will be the data extracted from every row ending in 9
Dim iCounter As Long
Dim newSheetRow As Long
Dim aValue As String
Dim bValue As String
newSheetRow = 1
'Start and nine and increment by 10 till you reach end of sheet
For iCounter = 9 To Sheet1.Rows.Count - 1 Step 10 'NOTE: You may not want to do it by RowCount, but just showing you could
aValue = Sheet1.Range("A" & iCounter)
bValue = Sheet1.Range("B" & iCounter)
Sheet2.Range("A" & newSheetRow).Value = "We were on row: " & iCounter
Sheet2.Range("B" & newSheetRow).Value = aValue
Sheet2.Range("C" & newSheetRow).Value = bValue
newSheetRow = newSheetRow + 1
Next iCounter
MsgBox "Done"
End Sub
You could use the INDIRECT function. It takes a cell reference as a text string and returns the value in that cell. So instead of using
=data!a9
to get the value in sheet "data" in cell a9, you use
=indirect("data!a9")
You can also use r1c1 notation, like this:
=indirect("data!r9c1",false)
From there you can use the ROW and COLUMN functions to go in steps of 10:
=INDIRECT("data!r"&-1+10*ROW()&"c"&COLUMN(),FALSE)
If you put this formula in A1 of your output sheet and then copy and paste it down and across, it will give you the values in data!A9, data!A19, data!A29,... in cells A1, A2, A3... Depending on how you want your output arranged, you might have to modify the cell reference string.
Depending on how often you want to do this depends on how you need to do it, if it's a one of them some simple excel commands might help.
e.g.
In Cell C1 put the following:
=MOD(ROW(),10)
then replicate this down to the bottom of your data. the command will return the numbers 1 through to 0. You can then filter the data on column C where value is 9 then select the visible rows and copy the data to a new sheet.
ROW() ' this returns the ROW number of cell the command is in.
MOD(number, divisor) ' this basically divides one number by the other and returns the remainder. so row 9 / 10 = 0 remainder of 9, row 19 / 10 = 1 remainder of 9.
Hope this helps.