I am trying to make a macro in vba to update information on sheet two from sheet one. The individual records are tied together by keys. So, one key corresponds to a record in sheet 1 and also a record in sheet two. I have the macro start off by defining the rows that are filled with data (at this stage it only has the a column). Then it enters a for loop and gets the entire rows and compares the two rows and updates them if they aren't the same. I am not sure how I would write the line for the if statement to compare the two rows that have the same key (since they aren't going to be in sequential order). Any help would be greatly appreciated. I have posted the code that I have written so far below.
Sub crossUpdate()
Dim rng1 As Range, rng2 As Range, N As Long
Dim rng1Row As Range
Dim rng2Row As Range
Dim i As Integer, j As Integer
Dim Cell As Variant
N = Cells(Rows.Count, "A").End(xlUp).row
Set rng1 = Sheet1.Cells.Range("A2:A" & N)
Set rng2 = Sheet2.Cells.Range("A2:A" & N)
For i = 2 To rng1.Rows.Count
Set rng1Row = rng1.Cells(i, 1).EntireRow
Set rng2Row = rng2.Cells(i, 1).EntireRow
Key = Sheet1.Range("A" & i)
For j = 1 To rng1.Columns.Count
If rng1Row.Cells(i, j).Value <> rng2Row.Cells(i, j).Value Then
Else
End If
Next j
Next i
End Sub
I answered a similar question here. The question asked how to compare rows.
My answer tried to quickly do these comparisons by storing a hash of the row. For your question, you could try converting both of the rows to a string and just comparing them like that. If they aren't equal, just copy one of the rows into the other.
Related
I am having a difficult time coming up with a solution for a project I'm working on. I am needing a Macro to look at a specific sheet, find a specific value, and cut/paste that value at the end of the row.
Looking at the example file I have attached, you can see that each customer has a unique ID in column A.
They are answering a questionnaire, and each answer they give generates a unique ID.
The order of the answer ID's doesn't matter, as they are unique. The only one that DOES matter is the answer with Semicolons. That answer ID needs to be the customer's last ID. So I need to find a way to cut these answer ID's and paste them to the end of each row.
I want the semi-colon answer to be the last answer in the array. First time posting on here so I'm sorry if the format is incorrect.
Updated: Example File
I think that this will do what you're looking for. It goes through columns and loops through each row in those columns and once it finds a cell with a ;, it just moves that value down to the bottom of the row it was found in.
Sub AnswerID()
Dim lastCol As Long
lastCol = Cells(1, Columns.count).End(xlToLeft).Column
Dim i As Long
For i = 1 To lastCol
Dim lastRow As Long
lastRow = Cells(Rows.count, i).End(xlUp).row
Dim j As Long
For j = 1 To lastRow
If InStr(Cells(j, i), ";") > 0 Then
Cells(lastRow, i).offset(1, 0).Value2 = Cells(j, i).Value2
Cells(j, i).Value2 = vbNullString
Exit For
End If
Next j
Next i
End Sub
I have a project that I am working on where multiple conditions are checked across all rows and many columns. The issue is that columns are added/removed from the sheet, and, at present, that results in all of my cell(row,column) references being off + outputting incorrect information. I'm wondering if there's a way to make my column references more robust so that they automatically find the correct headers and use them when checking? Would a solution to this problem be able to account for multiple columns containing the exact same header text?
Basically:
No blank columns
Column headers have repeats (e.g., Column 1 header: "Financials"; Column 15 header: "Financials")
Columns are shifting right and left based on adding/removing columns from sheet
Please find a short sample of my current code below with notes:
Dim i As Integer
Dim lastRow As Long
Dim lastCol As Long
lastRow = Range("A1").End(xlDown).Row
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lastRow
Select Case Cells(i, 14).Value
Case Is = "Yes"
Select Case True
Case Cells(i, 63).Value = 6 And _
(IsEmpty(Cells(i, 77)) Or IsEmpty(Cells(i, 93)) Or IsEmpty(Cells(i, 109)) Or _
IsEmpty(Cells(i, 125)) Or IsEmpty(Cells(i, 141)) Or IsEmpty(Cells(i, 157)))
Cells(i, 174).Value = "True" '^THESE CELL VALUES ALL HAVE THE SAME COLUMN HEADER TITLE
If the table is consistent - starting at A1 and occupying a contiguous block - then Range("A1").CurrentRegion will reference the table.
You can then use .CreateNames to name the columns (that is, using Named Ranges) according to their headings.
Dim rngTable As Range
Dim rng As Range
Set rngTable = Range("A1").CurrentRegion
rngTable.CreateNames True, False, False, False
' that is, based on the first row headings
Range("Salary").Select 'prove it works
'if necessary, iterate the cells of the column,
For Each rng In Range("Salary")
rng.Value = rng.Value + 10
Next 'rng
If a column heading is duplicated ("Financial"), though, then you'll be asked to confirm and the second occurrence will overrule the first. (Or you could say "No" and the first occurrence will be named.) In which case, it is preferable that you first correct these duplicate headings.
Correcting the duplicate headings is not necessarily straight forward, but something that you should resolve anyway. If it is a specific word "Financials" (or words) that could be duplicated then this makes the task easier. You could count how many occurrences there are, and correct the second, etc., to "Financials2".
One easy way to to assign a Name to the column. Say column N has the header "Payments". First assign the Name "Payments" to that column:
Then in VBA we can code like:
Sub dural()
Dim rng As Range, colly As Long
Set rng = Range("Payments")
colly = rng.Column
For i = 2 To 100
If Cells(i, colly) = "whatever" Then
MsgBox "Help"
End If
Next i
End Sub
The code will continue to work even if you add/remove columns beforre column N.
I have a report that I pull everyday that is placed in a very awekward format. It's contains a variable row count by 4 columns organized into unofficial tables based on the Name of each employee.
What I have is an employee name in column B preceded 2 blank rows above and followed by 1 blank row of data below.
What I want to accomplish is loop through the data, identify cells in column B <> blank, delete the entire 2 rows below that cell, and delete the entire 1 row above that cell.
Below is what I have so far. not much:
Sub test()
Dim currentSht As Worksheet
Dim startCell As Range
Dim lastRow As Long
Dim lastCol As Long
Dim i as integer
Set currentSht = ActiveWorkbook.Sheets(1)
Set startCell = currentSht.Range("A1")
lastRow = startCell.SpecialCells(xlCellTypeLastCell).Row
lastCol = startCell.SpecialCells(xlCellTypeLastCell).Column
For i = lastRow To 1
If Cells(i, "B").Value <> "" Then
End Sub
without making major changes to your code, try this:
For i = lastRow To 1 Step - 1
If Cells(i, "B").Value <> "" Then
Range(Cells(i, "B").Offset(1), Cells(i, "B").Offset(2)).EntireRow.Delete 'delete two below
Cells(i, "B").Offset(-1).EntireRow.Delete ' delete one above
You already get to your non-blank cell (ie Cells(i,"b")). To reference a range in relation to a cell you already have, use OFFSET.
So, and in this order, you select a range of cells from one below your cell Offset(1) to two cells below Offset(2)'. Change this range toENTIREROW` for those cells, and delete.
Then you select the cell above Offset(-1), select the ENTIREROW and delete.
as per your question narrative you'd possibly need to delete all rows that has a blank cell in column "B"
should that be the issue than you could (disclaimer: test it on a copy sheet!) simply go like follows:
Sub test()
With ActiveWorkbook.Sheets(1)
.Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Offset(, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
I have already created a VBA script that is about 160 lines long, which produces the report that you see below.
Without using cell references (because the date ranges will change each time I run this) I now need to take the users ID, name, total hours, total break, overtime 1, and overtime 2 and copy this data into sheet 2.
Any suggestions as to how I can structure a VBA script to search row B until a blank is found, when a blank is found, copy the values from column J, K, L, M on that row, and on the row above copy value C - now paste these values on sheet 2. - Continue this process until you find two consecutive blanks or the end of the data...
Even if you can suggest a different way to tackle this problem than the logic I have assumed above it would be greatly appreciated. I can share the whole code if you are interested and show you the data I began with.
Thank you in advance,
J
As discussed, here's my approach. All the details are in the code's comments so make sure you read them.
Sub GetUserNameTotals()
Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row
'Turn off AutoFilter to avoid errors.
ShTarget.AutoFilterMode = False
'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
With RngTarget
.AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
End With
'Logic: For each cell in the first column of stats, let's get its offset one cell above
'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
'copy first before the stats.
For Each CellRef In ColRef
If RngNames Is Nothing Then
Set RngNames = CellRef.Offset(-1, -7)
Else
Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
End If
Next CellRef
'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
'to you. Of course, modify as necessary.
RngNames.Copy ShPaste.Range("A1")
RngTargetVisible.Copy ShPaste.Range("B1")
End Sub
Screenshots:
Set-up:
Result:
Demo video here:
Using Filters and Visible Cells
Let us know if this helps.
Ok I have tried these and grasped some view on variants and I have written these code
Sub main()
Dim Vary As Variant
Vary = Sheet1.Range("A1:D11").Value
For i = 1 To UBound(Vary)
For j = i + 1 To UBound(Vary)
If Vary(i, 1) = Vary(j, 1) Then
'I should delete the vary(j,1) element from vary
'in excel sheet we use selection.entirerow.delete
End If
Next j
Next i
End Sub
This is the sample I tried
A B C D
1 somevalues in BCD columns
2
3
1
Now Delete the 4th row don think I'm working for unique records I'm just learning stuff to do and while I was learning variant I am stuck at this point deleting a complete row stored in variant
I have stored (A1:D11).value in variant
Now how can I delete the A6 element or row in variant so that I can avoid it while I copy the variant to some other sheet?
Can I also delete the C AND B columns in variant so that when i do transpose it wont copy the C and B columns?
I don't know what exactly a variant is - I was thinking to take a set of range and do operations like what we do for an excel sheet then take that variant and transpose it back to sheet.
Is that the right way of thinking or did I misunderstand the use of variants?
`variant(k,1)=text(x)` some array shows mismatch ? whats wrong?
If you are planning on using a varray to look at cells in each row to decide if you should delete the row or not, you should loop through your varray backwards, the same way you would if you did a for loop through the cell range. Since you are starting on row 1, the variable i will always equal the row number the element was located on, so you can use that to delete the proper row.
Here's a sample (more simple than what you are trying to do, though) that will delete each row in which the cells in columns A and B are the same.
Sub test()
Dim varray As Variant
varray = Range("A1:B11").Value
For i = UBound(varray, 1) To 1 Step -1
If varray(i, 1) = varray(i, 2) Then
Cells(i, 1).EntireRow.Delete
End If
Next
End Sub
Notes of interest:
UBound(varray, 1) gives the count of the rows
UBound(varray, 2) gives the count of the columns
One workaround without a second array is to introduce a deliberate error into an element you want to replace, then use SpecialCells to delete the cell after dumping the variant array back over the range. This sample introduces an error into the array position corresponding to A6 (outside the loop as its an example), then when the range is dumped to E1, the SpecialCell error removal shifts F6:H6 into E6:G6. ie
pls save before testing - this code will overwrite E6:H11 in the first worksheet
Sub main()
Dim Vary As Variant
Dim rng1 As Range
Set rng1 = Sheets(1).Range("A1:D11")
Set rng2 = rng1.Offset(0, 4)
Vary = rng1.Value2
For i = 1 To UBound(Vary)
For j = i + 1 To UBound(Vary)
'your test here
Next j
Next i
Vary(6, 1) = "=(1 / 0)"
With rng2
.Value2 = Vary
On Error Resume Next
.SpecialCells(xlFormulas, xlErrors).Delete xlToLeft
End With
End Sub