i have found many very similar questions in the forum, but somehow nothing fits what i am looking for.
I have two ranges (a & b) which i'd like to compare and if values do not match, i'd like to copy the entire row to a predefined worksheet. The purpose is to find rows / values that have been changed vs. previous edit.
Dim a, b as range
Dim ws1,ws2,ws3 as worksheet
Dim last_row, last_row2 as integer 'assume last_row =15, last_row2=12
Dim i, j, k as integer
last_row=15
last_row2=12
' the orignal range is not massive, but at 500x 6 not small either
Set a=ws1.range("I5:S"& last_row)
Set b=ws2.range("H2:R"& last_row2)
I have seen different approaches when it comes to addressing each item of the range and don't know which would be quickest / best (loop or for each ).
The main if-statement would look something like this:
'assume i, j are the used as counters running across the range
k = 1
If Not a(i).value=b(j).value then
a(i)EntireRow.copy
ws3.row(k).paste
k = k + 1
end if
The solution cannot be formula based, as I need to have ws3 saved after each comparison.
Any help on this is much appreciated. Thanks!
If you have the ability to leverage Excel Spill Ranges, you can achieve what you want without VBA. Here's a web Excel file that shows all rows in first sheet where column A does not equal column b.
=FILTER(Sheet1!A:ZZ,Sheet1!A:A<>Sheet1!B:B)
If VBA is required, this routine should work. It's not optimal for handling values (doesn't use an array), but it gets it done.
Sub listDifferences()
Dim pullWS As Worksheet, pushWS As Worksheet
Set pullWS = Sheets("Sheet1")
Set pushWS = Sheets("Sheet2")
Dim aCell As Range
For Each aCell In Intersect(pullWS.Range("A:A"), pullWS.UsedRange).Cells
If aCell.Value <> aCell.Offset(0, 1).Value Then
Dim lastRow As Long
lastRow = pushWS.Cells(Rows.Count, 1).End(xlUp).Row
pushWS.Rows(lastRow + 1).Value = aCell.EntireRow.Value
End If
Next aCell
End Sub
This is the small for-loop I ended up using.
Thanks for your input!
For i = 1 To rOutput.Cells.Count
If Not rOutput.Cells(i) = rBackUp.Cells(i) Then
' Debug.Print range1.Cells(i)
' Debug.Print range2.Cells(i)
rOutput.Cells(i).EntireRow.Copy wsChangeLog.Rows(k)
k = k + 1
End If
Next i
Related
I have data regarding benefits. At the bottom of these worksheets are adjustments. These should not be used in my Macros and formulas.
Instead of manually deleting, I'd like VBA to find "Adjustments" and delete that row and all rows below this. I have 3 worksheets I needs to this to repeat on.
I've googled and tried various codes but cannot seem to get it to read properly. Can anyone help?
First step is to find the first row of your Adjustments. You'll use .Find method to get that. Below is a sample line of code. You can google for more details and examples.
Once you have that, you'll find the last row, and then delete rows from start of adjustment rows to last row. I've included functions below that should help.
Set foundCell = rng.Cells.Find(varSearchValue, celStartCell, enuXlFindLookIn, enuXlLookAt)
Public Function LastUsedRow(wks As Worksheet) As Long
Dim rng As Range: Set rng = wks.UsedRange ' Excel will recalc used range
LastUsedRow = rng.Row + rng.Rows.Count - 1
End Function
Public Sub DeleteRows(wks As Worksheet, lngRowStart As Long, Optional ByVal lngRowEnd As Long = 0)
If lngRowEnd = 0 Then lngRowEnd = lngRowStart
wks.Rows(lngRowStart & ":" & lngRowEnd).Delete
End Sub
I've inferred that Adjustments is some sort of sub-level header row label. I'll assume that it is always in column A.
sub ScrubAdjustments()
dim w as long, wss as variant, m as variant
wss = array("sheet1", "sheet2", "sheet3")
for w = lbound(wss) to ubound(wss)
with worksheets(wss(w))
m = application.match("adjustments", .range("a:a"), 0)
if not iserror(m) then
.range(.cells(m, "A"), .cells(.rows.count, "A")).entirerow.delete
end with
end with
next w
end sub
I have multi-tables in one sheet, how to collect my interested data from them.
for example, I just need the data of table1 column 3, and table2 column 2.
the size for both tables may be variate. I need collect the data into array for next processing.
Thanks.
You need to find a way to restrict the tables in VBA, i.e. know in which row they start and of how many rows they consist. Because the tables can appear anywhere in the sheet with variate dimensions, there is no straight-forward way of extracting their data.
What I would suggest is to loop from the top to the lastrow of the sheet and on every row check if the table started and then in an inner loop iterate through the table rows until the table ends (i.e. an empty row is encountered).
The code might look similar to this (not tested):
Dim LastRow as Long, i as Long, k as Long
Dim sht as Worksheet
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row 'Assuming the tables start in column A
For i=1 to LastRow
If (sht.Range("A" & i) <> "" Then 'table is encountered
k = i
Do While sht.Range("A" & k) <> ""
... 'Get data from specific column
k = k + 1
Loop
End if
i = k
Next i
Try this (necessary comments are in code):
Option Explicit
Sub CollectData()
Dim table1Address As String, table2Address As String
' here you specify cells that are at the start of a column
table1Address = "B2"
table2Address = "C7"
Dim firstCell As Range, lastCell As Range
Dim table1Data, table2Data As Variant
' determine last cell in column and read whole column at once to an array variable
Set firstCell = Range(table1Address)
Set lastCell = Range(table1Address).End(xlDown)
table1Data = Range(firstCell, lastCell).Value2
Set firstCell = Range(table2Address)
Set lastCell = Range(table2Address).End(xlDown)
table2Data = Range(firstCell, lastCell).Value2
End Sub
The code I've written below to replace some index match formulas in a sheet. It seems to work well enough, but I think the loop is a bit clumsy and may be prone to errors. Does anyone have any recommended improvements?
Sub match_SIC_code_sheet_loop()
'sic code needs to match value in column j or a in sic code sheet, '
'if not available = met10 works, but probably needs a bit more
'debugging to make it robust.
Dim ws As Integer
Dim lastrow As Long
Dim lastrow_sic As Long
Dim output_wb As Workbook
Dim SIC_sheet As Worksheet
Dim Demand_CAT As String
Dim sic_DMA As String
Dim i As Integer
Dim row As Integer
Dim WS_count As Long
Dim x As String
Dim y As String
Set output_wb = Workbooks("DMA_customers_SICTEST.xlsx") 'use thisworkbook instead
Set SIC_sheet = Workbooks("DMA_metered_tool_v12_SICTEST.xlsm").Sheets("SIC codes")
With SIC_sheet 'count the number of SIC codes to search through
lastrow_sic = .Range("j" & .Rows.Count).End(xlUp).row
End With
With output_wb 'count the no. of sheets in the generated customer workbook
WS_count = output_wb.Worksheets.Count
End With
With output_wb
For ws = 1 To WS_count 'loop through each sheet in the customer workbook
With output_wb.Sheets(ws)
y = output_wb.Sheets(ws).Name
lastrow = .Range("a" & .Rows.Count).End(xlUp).row ' number of rows in the
'current customer sheet
For i = 2 To lastrow 'data starts in row 2; sic code in column 9
sic_DMA = .Cells(i, 9).Text 'the lookup value
With SIC_sheet
'SIC codes start in row 2, if the sic code matches,
'the correct demand category is appointed, if the sic code does not
'match, then MET_10 is given as the default value.
For row = 2 To lastrow_sic
x = .Cells(row, 3).Text
If x = sic_DMA Then
Demand_CAT = .Cells(row, 10).Text
Exit For
Else
Demand_CAT = "MET_10"
End If
Next row
output_wb.Sheets(ws).Cells(i, 23).Value = Demand_CAT
End With
Next i
End With
Next ws
End With
output_wb.Save
End Sub
Thanks
For starters you could break that long procedure into a few smaller methods. For example you could have a ProcessSheet procedure into which you pass each sheet under :
For ws = 1 To WS_count 'loop through each sheet in the customer workbook
That would definitely help readability etc. If you're still not satisfied then continue breaking the loop into smaller logical procedures. Just don't go too crazy.
Apart from that some error checking and value validation would go a long way in a deeply nested loop. For example ensure that various calculated variables such as 'lastrow' are correct or within a valid threshold etc.
Finally instead of hardcoded values sprinkled through your long loop like magically camoflauged debug-from-hell-where's-waldo fairies; prefer instead a few meaningfully named Const variable alternatives i.e.
Private Const SIC_START_ROW = 2
Ideally, I would have a range selected and then I would run the macro and I want the macro to essentially run a loop to go through each row so I can extract information from each row until it reaches the end of the range.
For example, A6:B9 are selected, first I want to focus on A6:B6. As in I want to be able to find the min value of the two cells for instance, using my MinSelected function(stated below) which requires a selected range which would ideally be A6:B6. And I want to do this for each row until the end of the original range.
Function MinSelected(R As Range)
MinSelected = Application.WorksheetFunction.min(R)
End Function
Is there any way to do this??? Please tell me to clarify anything that's unclear. Thanks in advance.
You can loop through rows - but looping through a variant array is more efficient (for many rows)
variant aray
Dim X
Dim lngCnt As Long
X = Range("A6:B9").Value2
For lngCnt = 1 To UBound(X)
Debug.Print Application.Min(Application.Index(X, lngCnt))
Next
range approach
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Range("A6:B9")
For Each rng2 In rng1.Rows
Debug.Print Application.Min(rng2)
Next
Use a For loop, Rows.Count property, Columns.Count
Dim i as long
For i = 1 to Selection.Rows.Count
For j = 1 To Selection.Columns.Count
Cells(i, j).Value ' Use this to access the value of cell in row i and column j
I need to create a macro that would look at every cells only in a specific column (i.e. not the whole spreadsheet) and starting at a specific row. Then, it would have all rows that does not contain my value of interests.
Lets say for example my goal is to search every value in column "A" and I'll filter from A2 to A99999999, leaving A1 untouched.I would then delete every row that does not contain 103526 and 103527 in column A.
The following code is able to filter through all the rows for my values of interest, however, I am having trouble filtering only ONE column and from A2 to A99999999. How can I change this code to meet those conditions?
Sub test()
Dim j As Integer, k As Integer
Dim r As Range, cfind6 As Range, cfind7 As Range
Worksheets("sheet1").Activate
On Error Resume Next
j = Cells(Rows.Count, "A").End(xlUp).Row
For k = j To 1 Step -1
Set cfind6 = Rows(k).Cells.Find(what:=103526, lookat:=xlWhole)
Set cfind7 = Rows(k).Cells.Find(what:=103527, lookat:=xlWhole)
If cfind6 Is Nothing And cfind7 Is Nothing Then Rows(k).Delete
Next
There are a couple of different ways to approach this, one way would be to change your code to something like:
Sub test()
Dim i As Integer
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
For i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Not (ws.Cells(i, 1).Value = 103526 Or ws.Cells(i, 1).Value = 103527) Then
ws.Cells(i, 1).EntireRow.Delete
End If
Next i
End Sub