View Full Version : [SOLVED:] Macro from this pseudo code?
tx7399
07-30-2015, 07:07 PM
Any help converting this pseudo code into vba would be greatly appreciated. Can it be done using the .Find method? Or Application.WorksheetFunction Index Match?
For each value in sheet 2 Col A
If not found in sheet1 Col B then
Sheet 2 Col A. entire row. Delete
End if
If found in sheet 1 Col B then
If sheet 2 Col A.Offset(0,3). value = sheet 1 Col B.Offset(0,15). Value then
Sheet 2 Col A.Offset(0,4).value = TAC
Else
Sheet 2 Col A.Offset(0,4).value =
End if
End if
Next
mancubus
07-31-2015, 12:05 AM
test with a copy of your file
i assume there is only 1 match in sheet1.
Sub vbax_53342_match_in_another_sheet()
Dim cll As Range, ValuesRange As Range
With Worksheets("Sheet2").Columns(1)
Set ValuesRange = Union(.SpecialCells(xlCellTypeConstants), .SpecialCells(xlCellTypeFormulas))
'when column contains both constants and formulas
'=
'Set ValuesRange = Union(.SpecialCells(2), .SpecialCells(-4123))
'Set ValuesRange = .SpecialCells(xlCellTypeConstants) 'only constants in column
'Set ValuesRange = .SpecialCells(xlCellTypeFormulas) 'if formulas in column
End With
For Each cll In ValuesRange
If Application.CountIf(Worksheets("Sheet1").Columns(2), cll.Value) = 0 Then
Worksheets("Sheet2").Rows(cll.Row).Delete
Else
FoundRow = Application.Match(cll.Value, Worksheets("Sheet1").Columns(2), 0)
If cll.Offset(0, 3).Value = Worksheets("Sheet1").Cells(FoundRow, 2).Offset(0, 15).Value Then
cll.Offset(0, 4).Value = "TAC"
Else
cll.Offset(0, 4).Value = ""
End If
End If
Next
End Sub
tx7399
07-31-2015, 03:21 PM
mancubus,
Thank you! I really appreciate your help. Sorry it took so long to get back to you. I used
Set ValuesRange = .SpecialCells(xlCellTypeConstants) 'only constants in column
because there are no formulas in the sheet.
The code runs fast but it doesn't delete all the rows where the sheet2 cell value does not exist
in sheet1 col B and I don't understand why. I have attached test data so you can see what I mean.
Sheet 2 rows 13-17 should be deleted but are not. What have I done wrong?
Regards,
Paul
tx7399
07-31-2015, 03:32 PM
Sorry, I forgot to attach this.
14045
p45cal
08-01-2015, 08:50 AM
Your attached TestData.xlsm isn't a very good file to test on since no rows need deleteing.
That aside, the problem is that the code runs down the cells in Sheet2, so when a row is deleted it skips a line altogether when it processes the next one. You need to run up those cells.
Change the line:
For Each cll In ValuesRange
to two lines:
For i = ValuesRange.Cells.Count To 1 Step -1
Set cll = ValuesRange.Cells(i)
Now this will work well, but only if the cells in ValuesRange are all contiguous.
To get round this we have to work through each of the areas of ValuesRange, working our way up through each of them, so:
Sub vbax_53342_match_in_another_sheet()
Dim cll As Range, ValuesRange As Range
Set ValuesRange = Worksheets("Sheet2").Columns(1).SpecialCells(xlCellTypeConstants) 'only constants in column
For Each are In ValuesRange.Areas
For i = are.Cells.Count To 1 Step -1
Set cll = are.Cells(i)
If Application.CountIf(Worksheets("Sheet1").Columns(2), cll.Value) = 0 Then
Worksheets("Sheet2").Rows(cll.Row).Delete
Else
FoundRow = Application.Match(cll.Value, Worksheets("Sheet1").Columns(2), 0)
If cll.Offset(0, 3).Value = Worksheets("Sheet1").Cells(FoundRow, 2).Offset(0, 15).Value Then
cll.Offset(0, 4).Value = "TAC"
Else
cll.Offset(0, 4).Value = ""
End If
End If
Next i
Next are
End Subshould work whether ValuesRange is contiguous or not.
tx7399
08-01-2015, 01:55 PM
Thank you p45cal. Works perfectly.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.