I have a file with a bunch of rows that contains data for certain part numbers from different configurations. Some of these part numbers are repeated throughout the file, and in those duplicated part numbers may contain certain data and some may not. I am trying to find the best way to determine the commonalities in the file for certain data. So for the commonalities, if one row has a value and another row is blank, the value for the nonblank row would be put into the blank row. And if the data on those two rows were different it would change the font color on the cell indicating that this part number two different unique values and should be checked.
Dim i, j, n As Long
Dim lr As Long
Dim moaf As Workbook
Dim sht As Worksheet
Application.ScreenUpdating = False
Set moaf = Workbooks("MOAF3.xlsb")
Set sht = moaf.Worksheets("Wire Data")
n = InputBox("What column # are you trying to fill in?: ")
lr = Cells(Rows.count, 2).End(xlUp).Row
For i = 2 To lr
lkup = Cells(i, 2).Value 'sets first lookup value
Fill = Cells(i, n).Value 'sets the first data value to compare
If Len(Fill) > 0 Then
For j = 2 To lr
lkup2 = Cells(j, 2).Value 'sets the second lookup value
Fill2 = Cells(j, n).Value 'sets the second value to compare
If lkup2 = lkup Then 'checks to see if p/ns are same
If Len(Fill2) = 0 Then 'checks to see if second value is blank
Cells(j, n).Value = Fill 'if value is blank the cell takes value of non blank cell
ElseIf Fill <> Fill2 Then 'checks to see if the values are non matching and non zero
Cells(i, n).Font.ColorIndex = 3 'changes font color of two cells
Cells(j, n).Font.ColorIndex = 3 'changes font color of two cells
End If
End If
Next j
End If
Next i
Application.ScreenUpdating = True
End Sub
Doing this generally freezes my excel, where my computer has 32GB of RAM and is Windows10. Is there a better approach for my problem, or is it something that can be done without using a vba? I've done some research on a method without using vba, but with like sumifs, countifs but haven't really done any deep dives.
So, if I understand your question correctly, you start with following data:
ID Column_header
2 a
3 _BLANK_
4 _BLANK_
5 b
6 _BLANK_
And you want to turn this into:
ID Column_header
2 a
3 a
4 a
5 b
6 b
I know a very simple trick for that (I have put everything in column 'A' for explanation):
Select every cell inside that column
Goto (Ctrl+G) Special, Blanks
In the formula bar, type =A2 (you are currently located in 'A3', and you want to copy there the value of the cell just above it)
Press Ctrl+ENTER
You'll see that 'A2' gets copied into 'A3', 'A3' into 'A4' and 'A5' into 'A6' (the fact that this is done for all blank cells, is due to the Ctrl+ENTER).
Record this into a macro, and it will go much faster.
I already see a question popping up : "Ok, but what about the font colour I want to change?". Well, the newly filled cells are based on a formula, so the length of =FORMULATEXT() won't be zero. You use this as a basis for conditional formatting.
Good luck
The inner for loop just needs to start at i, that is:
for j = i to lr
This should roughly half the runtime.
Further performance enhencements:
Use .Value2 instead of .Value property.
Or even better, read in the entire columns into an array, work on that in VBA, then write the result back.
Related
As shown in image, I am trying to fill numbers in increasing order in alternate merged cells, which are different in size. So, I can't use autofill function of excel. But I want a macro so I can do it every time just hitting button once.
Note that I want numbers till the used range only.
I tried a lot to do it my self, but I am stuck now...Plz help the beginner, it's my third day in VBA.
This should do what you are looking for.
It will ignore non merged cells, I didn't see any in your screenshot that needed a number and were not merged so that shouldn't be an issue.
It uses column B to figure out the last row of your data.
Dim i As Long
Dim lr As Long
Dim counter As Long
counter = 1
With Sheet1 'Change to whatever your sheets code name is
lr = .Cells(.Rows.Count, 2).End(xlUp).Row 'If you want to use something other than column B, change the 2 to the right column index
For i = 2 To lr
If .Cells(i, 1).MergeCells = True Then
If .Cells(i, 1).MergeArea.Item(1).Address = .Cells(i, 1).Address Then
.Cells(i, 1) = counter
counter = counter + 1
End If
End If
Next i
End With
Need a little help here.
In the "Data" Tab I want to copy values in column "c2:c1000" and paste in column "a1" of another Tab.
This is what i have so far,
Dim x As Long
Dim lastRow As Long
lastRow = Worksheet("Data").Cells(3, Columns.Count).End(xlUp).Column
For x = 1 To lastRow
If Worksheets("Sheet2").Cells(2, "A") = "" Then
Worksheets("Data").Range("c2:c1000").Copy Destination:=Worksheets("Sheet2").Range(1, "A")
Sheets("Sheet2").Range("A1").Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
Else
Worksheets("Data").Range("c2:c1000").Copy Destination:=Worksheets("Sheet2").Cells(2,
Columns.Count).End(xlToLeft).Offset(, 1)
'Sheets("Sheet2").Range("A1").Value = Format(Now, "mm/dd/yyyy HH:mm:ss") --> can't figure how to increment this as this will need to be on the subsequent empty column
End If
Next
End Sub
Your help will be greatly appreciated!
Thank you.
Pasting values first into range A1 and down and then next time to cell B1 and so on, leaves no space for the timestamp to A1, B1 etc. So, I assume that you would like to paste the random values to row 2. So cells A1, B1, ... are left for the timestamp.
Inside the With statements we can refer to properties of the wsAudit so we can replace the "Worksheets("Audit")." reference with just "."
The column.count expression just checks the amount of columns in the worksheet.
The expression .Cells(2, Columns.Count) just points to last cell in the row 2.
The .End(xlToLeft).Column then looks from this column to left and is supposed to find the last not empty cell on this row. It's basically the same idea that in Excel's sheet you would go to cell XDF2 and hit CTRL+Arrow Left from keyboard.
But instead of activating the cell we just want to get the columns index number and then add 1 (the new column) and save it into variable. Now the new column is known.
The expression Range(.Cells(2, newColAudit), .Cells(1000, newColAudit)).Value is really the same as e.g. Range("B2:B1000"), but with this we can use the row and column index numbers instead. This is useful as the column number varies.
And as Samuel pointed out the copy paste operation can be avoided by setting the areas equal.
Dim wsAudit As Worksheet
Dim newColAudit As Long
Set wsAudit = Worksheets("Audit")
With wsAudit
newColAudit = .Cells(2, Columns.Count).End(xlToLeft).Column + 1
Range(.Cells(2, newColAudit), .Cells(1000, newColAudit)).Value = Worksheets("Data").Range("C2:C1000").Value
.Cells(1, newColAudit).Value = Format(Now, "mm/dd/yyyy HH:mm:ss")
End With
Much like your LastRow* variable for your source sheet, create a LastColumn variable for your destination sheet, which will find the last used column the same way you are finding your last used row.
Like so:
Dim LastColumn As Long
LastColumn = Sheets("Audit").Cells(1, Columns.Count).End(xlToLeft).Column
Then use the variable like so:
Destination:= Worksheets("Audit").Cells(1, LastColumn)
It seems that your code contradicts your question too, in your question you explained the data will be written to the Audit sheet in row 1, using the next column each time but your code looks for values in row 2 in your If statement:
If Worksheets("Audit").Cells(2, "A") = "" Then is the same as If Worksheets("Audit").Range("A2") = "" Then.
If you mean to check the first row, change the 2 to 1.
To help improve your codes efficiency:
(Also see the link to 'how to avoid select' in that question):
You can achieve 'copy/paste' without actually using the 'copy' and 'paste' methods by assigning the value of one range to the other, as example, like so:
Worksheets("Audit").Cells(1, LastColumn).Resize(999, 1) = Worksheets("Data").Range("c2:c1000").Value
Note: Change the Resize Property rows to suit the source range (in this case you are wanting to move values from C2:C1000).
*The LastRow variable is a bit confusing, as it is looking for the last used column in row 3.
If it's meant to find a column, consider renaming it to avoid confusion later on in debugging.
If it's meant to find the last row, try like this:
LastRow = Worksheet("Data").Cells(Rows.Count, 1).End(xlUp).Row
Say I have an Excel sheet with 10,000 rows and two columns. All 20,000 cells are filled with numbers and there is no missing data. I want to have a third column, the values of which are the sum of Column A and Column B. For example, C70 = A70 + B70, and C82 = A82 + 82, and the like.
The only problem is I want to do it for only a portion of the rows, say from row 125 to row 8954. I don't care about the rest of the values. And I don't want to do it by dragging the grid using the mouse. Is that possible?
If you have access to SEQUENCE() (Currently only available to Office 365 Insiders) then yes it is possible:
=INDEX(A:A,SEQUENCE(1000,,ROW(),1))+INDEX(B:B,SEQUENCE(1000,,ROW(),1))
Where 1000 is the number of rows desired. Place the formula in the first cell desired and it will automatically fill the rest.
I believe you need some logic about what is going on, related to the start and end row.
You can use an if-statement or sumifs() for this... will do an if-statement so i can specify not meeting the requirements as null.
With Start row as 2 and end row as 4 (see image), you can use this formula, and drag it down to the bottom of all columns:
=IF(AND(ROW(A2)<=F$2,ROW(A2)>=E$2),SUM(A2:B2),"")
Notice in the image that C5 has no value; this is due to the conditions of the if-statement being false.
Another idea, a simple macro that will do what you want by asking the user what the starting and end row is.
Sub test()
Dim startrow As Integer 'variable to hold first row
Dim endrow As Integer 'variable to hold last row
startrow = InputBox("Enter the start row")
endrow = InputBox("Enter the end row")
'loops through you desired range calculating what you want
Dim i As Integer
For i = startrow To endrow
Cells(i, 4).Value = Cells(i, 1).Value + Cells(i, 2).Value
Next
End Sub
Just change the values to suit your needs in what cells you want to add up and where you want the sum to go.
I am trying to Create a Formula that checks 4 Cells next to each other if they have the same number once positive and once negative see in the example:
If the formula sees there is a Plus 50 and a Minus 50 its has to colour the cell on the right side or the cells with the numbers blue.
The list is a inventory of multiple stores if one store sells alot of that product and may run out they ask another store to restock the product. Sometimes they forget to send a note. This List is supposed to make the control as easy as possible.
I expect the formula to color the cell on the right side of the list to be colored blue if 2 of the cells have the same value in plus and minus.
I tried to use cell formatting rules but its not possible to do it with that.
Another Example since people seem to have trouble understanding what the formula should do:
I marked every cell blue like the formula should and yellow colored value is the reason.
You can do this, using conditional formatting, using this formula (just for the first row):
=OR(A1+B1=0;B1+C1=0;C1+D1=0)
This formula checks if the sum of two adjacent cells equals zero, which is another way of saying that they should have the same value, but opposite signs.
Obviously, you might consider changing this formula, e.g.:
Instead of:
A1+B1=0
you put:
AND(A1+B1=0;A1<>0)
When the sum of two values equals zero and at least one of them is not zero, then both are not zero.
All this together in one formula yields the following:
=OR(AND(A1+B1=0;A1<>0);AND(B1+C1=0;B1<>0);AND(C1+D1=0;C1<>0))
Use such a formula in the conditional formatting of cell E1, and apply this for all cells in E column.
Try:
Option Explicit
Sub test()
Dim Row As Long, Column As Long
Dim rng As Range
'Let us assume that we use Sheet1 & columns A to F
With ThisWorkbook.Worksheets("Sheet1")
For Row = 2 To 100 ' <- Let us assume that data starts in row 2 and ends in row 100
Set rng = .Range("B" & Row & ":E" & Row)
For Column = 2 To 6
If .Cells(Row, Column).Value <> 0 Then
If Application.WorksheetFunction.CountIf(rng, (-1 * .Cells(Row, Column).Value)) > 0 Then
.Range("F" & Row).Interior.Color = vbBlue
Exit For
End If
End If
Next Column
Next Row
End With
End Sub
I need to be able to
-compare row data for each column(from cell B2; to the end, ie. whole worksheet minus first row and column)
-if no data changes in said column; then highlight the column heading
-if data changes; highlight the first cell where the data is changing
please see example, keep in mind the excel sheets I have are much much larger, like huge, so using reference columns wont work, and multiple formulas for each column wont work either. I found this for single column and its great, =INDIRECT("A"&ROW())<>INDIRECT("A"&(ROW()-1)), but I can't apply this to over 100 columns, not practical. Please help.
Bahh, I wrote one myself, its not dynamic on the number of rows or columns yet, but it does the job, and I think I don't have to go through both rows and columns, but I couldn't figure out how to reference the cell positions otherwise fast enough. Better then RobB solution, flapping his gums.
Private Sub CommandButton1_Click()
Dim i As Long
Dim j As Long
Dim flag As Boolean
Columns().Font.Color = vbBlack
Rows().Interior.ColorIndex = 0
flag = False
For j = 2 To 120 'Must hard code number of columns
For i = 3 To 3300 'Must hard code numbe of rows
If Cells(i, j).Value <> Cells(i - 1, j) And Not IsEmpty(Cells(i, j).Value) Then
Cells(i, j).Interior.ColorIndex = 37
flag = True
Else
If flag Then
Cells(1, j).Interior.ColorIndex = 36
End If
End If
Next i
flag = False
Next j
End Sub
This sounds like a simple task for a macro - though this would require you to do something manually (eg press a key) to initiate the comparison.